{-# LANGUAGE DuplicateRecordFields #-}
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}

-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2025 Wire Swiss GmbH <opensource@wire.com>
--
-- 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 <https://www.gnu.org/licenses/>.

module Test.Brig where

import API.Brig as BrigP
import qualified API.BrigInternal as BrigI
import API.Common
import API.GalleyInternal (setTeamFeatureStatus)
import API.Spar
import Control.Monad.Reader (asks)
import Control.Retry
import Data.Aeson.Types hiding ((.=))
import qualified Data.ByteString.Base64 as B64
import Data.List.Split
import Data.String.Conversions
import qualified Data.Text as Text
import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime)
import qualified Data.UUID as UUID
import qualified Data.UUID.V4 as UUID
import GHC.Stack
import OpenSSL (withOpenSSL)
import OpenSSL.EVP.Digest (getDigestByName, hmacBS)
import SetupHelpers
import System.Directory (copyFile)
import System.FilePath ((</>))
import System.IO.Extra hiding (putStrLn)
import Testlib.Assertions
import Testlib.Prelude
import UnliftIO.Concurrent (threadDelay)
import UnliftIO.Exception (finally)
import UnliftIO.Temporary

testCrudFederationRemotes :: (HasCallStack) => App ()
testCrudFederationRemotes :: HasCallStack => App ()
testCrudFederationRemotes = do
  otherDomain <- Domain -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString Domain
OtherDomain
  withModifiedBackend def $ \String
ownDomain -> do
    let parseFedConns :: (HasCallStack) => Response -> App [Value]
        parseFedConns :: HasCallStack => Response -> App [Value]
parseFedConns Response
resp =
          -- Pick out the list of federation domain configs
          HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200 Response
resp App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"remotes"
            App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
              -- Enforce that the values are objects and not something else
              App [Value] -> ([Value] -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> App Value) -> [Value] -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Object -> Value) -> App Object -> App Value
forall a b. (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Object -> Value
Object (App Object -> App Value)
-> (Value -> App Object) -> Value -> App Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> App Object
forall a. (HasCallStack, MakesValue a) => a -> App Object
asObject)

        addTest :: (MakesValue fedConn, Ord fedConn2, ToJSON fedConn2, MakesValue fedConn2, HasCallStack) => fedConn -> [fedConn2] -> App ()
        addTest :: forall fedConn fedConn2.
(MakesValue fedConn, Ord fedConn2, ToJSON fedConn2,
 MakesValue fedConn2, HasCallStack) =>
fedConn -> [fedConn2] -> App ()
addTest fedConn
fedConn [fedConn2]
want = do
          App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (String -> fedConn -> App Response
forall dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> App Response
BrigI.createFedConn String
ownDomain fedConn
fedConn) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
res -> do
            String -> App () -> App ()
forall a. String -> App a -> App a
addFailureContext (String
"res = " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Response -> String
forall a. Show a => a -> String
show Response
res) (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
            res2 <- HasCallStack => Response -> App [Value]
Response -> App [Value]
parseFedConns (Response -> App [Value]) -> App Response -> App [Value]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> App Response
forall dom. (HasCallStack, MakesValue dom) => dom -> App Response
BrigI.readFedConns String
ownDomain
            sort res2 `shouldMatch` sort want

        updateTest :: (MakesValue fedConn, Ord fedConn2, ToJSON fedConn2, MakesValue fedConn2, HasCallStack) => String -> fedConn -> [fedConn2] -> App ()
        updateTest :: forall fedConn fedConn2.
(MakesValue fedConn, Ord fedConn2, ToJSON fedConn2,
 MakesValue fedConn2, HasCallStack) =>
String -> fedConn -> [fedConn2] -> App ()
updateTest String
domain fedConn
fedConn [fedConn2]
want = do
          App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (String -> String -> fedConn -> App Response
forall owndom fedConn.
(HasCallStack, MakesValue owndom, MakesValue fedConn) =>
owndom -> String -> fedConn -> App Response
BrigI.updateFedConn String
ownDomain String
domain fedConn
fedConn) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
res -> do
            String -> App () -> App ()
forall a. String -> App a -> App a
addFailureContext (String
"res = " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Response -> String
forall a. Show a => a -> String
show Response
res) (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
            res2 <- HasCallStack => Response -> App [Value]
Response -> App [Value]
parseFedConns (Response -> App [Value]) -> App Response -> App [Value]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> App Response
forall dom. (HasCallStack, MakesValue dom) => dom -> App Response
BrigI.readFedConns String
ownDomain
            sort res2 `shouldMatch` sort want

    dom1 :: String <- (String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".example.com") (String -> String) -> (UUID -> String) -> UUID -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> String
UUID.toString (UUID -> String) -> App UUID -> App String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UUID -> App UUID
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UUID
UUID.nextRandom

    let remote1, remote1' :: BrigI.FedConn
        remote1 = String -> String -> Maybe [String] -> FedConn
BrigI.FedConn String
dom1 String
"no_search" Maybe [String]
forall a. Maybe a
Nothing
        remote1' = FedConn
remote1 {BrigI.searchStrategy = "full_search", BrigI.restriction = Just []}

        cfgRemotesExpect :: BrigI.FedConn
        cfgRemotesExpect = String -> String -> Maybe [String] -> FedConn
BrigI.FedConn (String -> String
forall a b. ConvertibleStrings a b => a -> b
cs String
otherDomain) String
"full_search" Maybe [String]
forall a. Maybe a
Nothing

    cfgRemotes <- parseFedConns =<< BrigI.readFedConns ownDomain
    cfgRemotes `shouldMatch` ([] @Value)
    -- entries present in the config file can be idempotently added if identical, but cannot be
    -- updated.
    addTest cfgRemotesExpect [cfgRemotesExpect]
    -- create
    addTest remote1 [cfgRemotesExpect, remote1]
    addTest remote1 [cfgRemotesExpect, remote1] -- idempotency
    -- update
    updateTest (BrigI.domain remote1) remote1' [cfgRemotesExpect, remote1']

testCrudOAuthClient :: (HasCallStack) => App ()
testCrudOAuthClient :: HasCallStack => App ()
testCrudOAuthClient = do
  user <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  let appName = String
"foobar"
  let url = String
"https://example.com/callback.html"
  clientId <- bindResponse (BrigI.registerOAuthClient user appName url) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"client_id"
  bindResponse (BrigI.getOAuthClient user clientId) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"application_name" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
appName
    Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"redirect_url" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
url
  let newName = String
"barfoo"
  let newUrl = String
"https://example.com/callback2.html"
  bindResponse (BrigI.updateOAuthClient user clientId newName newUrl) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"application_name" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newName
    Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"redirect_url" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newUrl
  bindResponse (BrigI.deleteOAuthClient user clientId) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
  bindResponse (BrigI.getOAuthClient user clientId) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
404

testCrudFederationRemoteTeams :: (HasCallStack) => App ()
testCrudFederationRemoteTeams :: HasCallStack => App ()
testCrudFederationRemoteTeams = do
  (_, tid, _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  (_, tid2, _) <- createTeam OwnDomain 1
  rd <- (\String
n -> String
n String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".wire.com") <$> randomName
  bindResponse (BrigI.addFederationRemoteTeam' OwnDomain rd tid) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
533
  void $ BrigI.createFedConn OwnDomain $ BrigI.FedConn rd "full_search" Nothing
  bindResponse (BrigI.addFederationRemoteTeam' OwnDomain rd tid) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
533
  void $ BrigI.updateFedConn OwnDomain rd $ BrigI.FedConn rd "full_search" (Just [])
  bindResponse (BrigI.getFederationRemoteTeams OwnDomain rd) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response -> [String] -> App ()
checkAbsence Response
resp [String
tid, String
tid2]
  BrigI.addFederationRemoteTeam OwnDomain rd tid
  bindResponse (BrigI.getFederationRemoteTeams OwnDomain rd) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response -> [String] -> App ()
checkPresence Response
resp [String
tid]
    Response -> [String] -> App ()
checkAbsence Response
resp [String
tid2]
  BrigI.addFederationRemoteTeam OwnDomain rd tid2
  bindResponse (BrigI.getFederationRemoteTeams OwnDomain rd) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response -> [String] -> App ()
checkPresence Response
resp [String
tid, String
tid2]
  BrigI.deleteFederationRemoteTeam OwnDomain rd tid
  bindResponse (BrigI.getFederationRemoteTeams OwnDomain rd) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response -> [String] -> App ()
checkPresence Response
resp [String
tid2]
    Response -> [String] -> App ()
checkAbsence Response
resp [String
tid]
  BrigI.deleteFederationRemoteTeam OwnDomain rd tid2
  bindResponse (BrigI.getFederationRemoteTeams OwnDomain rd) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response -> [String] -> App ()
checkAbsence Response
resp [String
tid, String
tid2]
  where
    checkAbsence :: Response -> [String] -> App ()
    checkAbsence :: Response -> [String] -> App ()
checkAbsence Response
resp [String]
tids = do
      l <- Response
resp.json Maybe Value -> (Maybe Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& Maybe Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
      remoteTeams <- forM l (\Value
e -> Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"team_id" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString)
      when (any (\String
t -> String
t String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
remoteTeams) tids) $ assertFailure "Expected response to not contain any of the teams"

    checkPresence :: Response -> [String] -> App ()
    checkPresence :: Response -> [String] -> App ()
checkPresence Response
resp [String]
tids = do
      l <- Response
resp.json Maybe Value -> (Maybe Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& Maybe Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
      remoteTeams <- forM l (\Value
e -> Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"team_id" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString)
      when (any (\String
t -> String
t String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
remoteTeams) tids) $ assertFailure "Expected response to contain all of the teams"

testSFTCredentials :: (HasCallStack) => App ()
testSFTCredentials :: HasCallStack => App ()
testSFTCredentials = do
  let ttl :: Int
ttl = (Int
60 :: Int)
  String -> (String -> Handle -> App ()) -> App ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (String -> Handle -> m a) -> m a
withSystemTempFile String
"sft-secret" ((String -> Handle -> App ()) -> App ())
-> (String -> Handle -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
secretFile Handle
secretHandle -> do
    IO () -> App ()
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> App ()) -> IO () -> App ()
forall a b. (a -> b) -> a -> b
$ do
      Handle -> String -> IO ()
hPutStr Handle
secretHandle String
"xMtZyTpu=Leb?YKCoq#BXQR:gG^UrE83dNWzFJ2VcD"
      Handle -> IO ()
hClose Handle
secretHandle
    ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend
      ( ServiceOverrides
forall a. Default a => a
def
          { brigCfg =
              ( setField "sft.sftBaseDomain" "integration-tests.zinfra.io"
                  . setField "sft.sftToken.ttl" ttl
                  . setField "sft.sftToken.secret" secretFile
                  . setField "sft.sftDiscoveryIntervalSeconds" (1 :: Int)
                  . setField "optSettings.setSftListAllServers" "enabled"
              )
          }
      )
      ((HasCallStack => String -> App ()) -> App ())
-> (HasCallStack => String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
domain -> do
        user <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domain CreateUser
forall a. Default a => a
def

        sftServersAll <-
          retrying
            (limitRetriesByCumulativeDelay 2_000_000 $ fullJitterBackoff 50_000)
            (\RetryStatus
_ [Value]
xs -> let shouldRetry :: Bool
shouldRetry = [Value] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Value]
xs in Bool -> App Bool
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
shouldRetry)
            $ \RetryStatus
_ -> do
              resp <- Value -> App Response
forall dom. (HasCallStack, MakesValue dom) => dom -> App Response
getCallsConfigV2 Value
user
              resp.json %. "sft_servers_all" & asList

        when (null sftServersAll) $ assertFailure "sft_servers_all empty"
        for_ sftServersAll $ \Value
s -> do
          cred <- Value
s Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"credential" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
          when (null cred) $ assertFailure "credential missing"
          usr <- s %. "username" & asString
          let parts = String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
"." String
usr
          when (length parts /= 5) $ assertFailure "username should have 5 parts"
          when (take 2 (head parts) /= "d=") $ assertFailure "missing expiry time identifier"
          when (take 2 (parts !! 1) /= "v=") $ assertFailure "missing version identifier"
          when (take 2 (parts !! 2) /= "k=") $ assertFailure "missing key ID identifier"
          when (take 2 (parts !! 3) /= "s=") $ assertFailure "missing federation identifier"
          when (take 2 (parts !! 4) /= "r=") $ assertFailure "missing random data identifier"
          for_ parts $ \String
part -> Bool -> App () -> App ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
part Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3) (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ String -> App ()
forall a. HasCallStack => String -> App a
assertFailure (String
"value missing for " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
part)

testSFTNoCredentials :: (HasCallStack) => App ()
testSFTNoCredentials :: HasCallStack => App ()
testSFTNoCredentials = ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend
  ( ServiceOverrides
forall a. Default a => a
def
      { brigCfg =
          ( setField "sft.sftBaseDomain" "integration-tests.zinfra.io"
              . setField "optSettings.setSftListAllServers" "enabled"
          )
      }
  )
  ((HasCallStack => String -> App ()) -> App ())
-> (HasCallStack => String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
domain -> do
    user <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domain CreateUser
forall a. Default a => a
def
    bindResponse (getCallsConfigV2 user) \Response
resp -> do
      sftServersAll <- Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"sft_servers_all" App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
      when (null sftServersAll) $ assertFailure "sft_servers_all missing"
      for_ sftServersAll $ \Value
s -> do
        credM <- Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Value
s String
"credential"
        when (isJust credM) $ assertFailure "should not generate credential"
        usrM <- lookupField s "username"
        when (isJust usrM) $ assertFailure "should not generate username"

testSFTFederation :: (HasCallStack) => App ()
testSFTFederation :: HasCallStack => App ()
testSFTFederation = do
  ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend
    ( ServiceOverrides
forall a. Default a => a
def
        { brigCfg =
            ( setField "sft.sftBaseDomain" "integration-tests.zinfra.io"
                . removeField "multiSFT"
            )
        }
    )
    ((HasCallStack => String -> App ()) -> App ())
-> (HasCallStack => String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
domain -> do
      user <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domain CreateUser
forall a. Default a => a
def
      bindResponse (getCallsConfigV2 user) \Response
resp -> do
        isFederatingM <- Maybe Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Response
resp.json String
"is_federating"
        when (isJust isFederatingM) $ assertFailure "is_federating should not be present"
  ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend
    ( ServiceOverrides
forall a. Default a => a
def
        { brigCfg =
            ( setField "sft.sftBaseDomain" "integration-tests.zinfra.io"
                . setField "multiSFT" True
            )
        }
    )
    ((HasCallStack => String -> App ()) -> App ())
-> (HasCallStack => String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
domain -> do
      user <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domain CreateUser
forall a. Default a => a
def
      bindResponse (getCallsConfigV2 user) \Response
resp -> do
        isFederating <-
          App Bool -> (Value -> App Bool) -> Maybe Value -> App Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> App Bool
forall a. HasCallStack => String -> App a
assertFailure String
"is_federating missing") Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
asBool
            (Maybe Value -> App Bool) -> App (Maybe Value) -> App Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Response
resp.json String
"is_federating"
        unless isFederating $ assertFailure "is_federating should be true"
  ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend
    ( ServiceOverrides
forall a. Default a => a
def
        { brigCfg =
            ( setField "sft.sftBaseDomain" "integration-tests.zinfra.io"
                . setField "multiSFT" False
            )
        }
    )
    ((HasCallStack => String -> App ()) -> App ())
-> (HasCallStack => String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
domain -> do
      user <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domain CreateUser
forall a. Default a => a
def
      bindResponse (getCallsConfigV2 user) \Response
resp -> do
        isFederating <-
          App Bool -> (Value -> App Bool) -> Maybe Value -> App Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> App Bool
forall a. HasCallStack => String -> App a
assertFailure String
"is_federating missing") Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
asBool
            (Maybe Value -> App Bool) -> App (Maybe Value) -> App Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Response
resp.json String
"is_federating"
        when isFederating $ assertFailure "is_federating should be false"

-- | Backs up @cfgDest@, runs the action with an updater that replaces the file
-- content (via copy so brig's filewatch notices), and restores the backup. The
-- 1s sleep gives brig's file watcher time to reload the file before the next
-- assertion.
withModifiedTurnFile :: FilePath -> ((String -> App ()) -> App ()) -> App ()
withModifiedTurnFile :: String -> ((String -> App ()) -> App ()) -> App ()
withModifiedTurnFile String
cfgDest (String -> App ()) -> App ()
action =
  String -> (String -> App ()) -> App ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (String -> m a) -> m a
withSystemTempDirectory String
"wire.temp" ((String -> App ()) -> App ()) -> (String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
tmpDir -> do
    let backup :: String
backup = String
tmpDir String -> String -> String
</> String
"turn.bak"
    IO () -> App ()
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> App ()) -> IO () -> App ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
copyFile String
cfgDest String
backup
    (String -> App ()) -> App ()
action (\String
s -> String -> String -> String -> App ()
setTurn String
tmpDir String
cfgDest String
s) App () -> App () -> App ()
forall (m :: * -> *) a b. MonadUnliftIO m => m a -> m b -> m a
`finally` IO () -> App ()
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> String -> IO ()
copyFile String
backup String
cfgDest)

-- | This essentially writes 'newConf' to @cfgDest@, but in a portable way that
-- makes sure brig's filewatch notices that the file has changed.
setTurn :: FilePath -> FilePath -> String -> App ()
setTurn :: String -> String -> String -> App ()
setTurn String
tmpDir String
cfgDest String
newConf = do
  let tmpFile :: String
tmpFile = String
tmpDir String -> String -> String
</> String
"turn.txt"
  IO () -> App ()
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> App ()) -> IO () -> App ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
writeFile String
tmpFile String
newConf
  IO () -> App ()
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> App ()) -> IO () -> App ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
copyFile String
tmpFile String
cfgDest
  Int -> App ()
forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay Int
1000000

-- | Asserts coturn native long-term credentials on a @/calls/config/v3@
-- response: @username = "<unix-expiry>:<uid>"@ with future expiry and non-empty
-- [a-z0-9] uid, and @credential = base64(HMAC-SHA1(secret, username))@.
assertCoturnCredentials :: (HasCallStack) => FilePath -> Value -> App ()
assertCoturnCredentials :: HasCallStack => String -> Value -> App ()
assertCoturnCredentials String
secretPath Value
cfg = do
  raw <- IO String -> App String
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO String
readFile String
secretPath)
  let secret = Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> Text
Text.strip (String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
raw :: Text.Text)) :: ByteString
  now <- liftIO getPOSIXTime
  mSha1 <- liftIO . withOpenSSL $ getDigestByName "SHA1"
  sha1 <- maybe (assertFailure "SHA1 digest not available") pure mSha1
  iceServers <- cfg %. "ice_servers" & asList
  for_ iceServers $ \Value
ice -> do
    urls <- Value
ice Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"urls" App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App [String]) -> App [String]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> App String) -> [Value] -> App [String]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
    when (null urls) $ assertFailure "ice server urls missing"
    uname <- ice %. "username" & asString
    case break (== ':') uname of
      (String
expiryStr, Char
':' : String
uid') -> do
        HasCallStack => String -> Bool -> App ()
String -> Bool -> App ()
assertBool String
"coturn username expiry should be numeric" ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
expiryStr Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
expiryStr))
        HasCallStack => String -> Bool -> App ()
String -> Bool -> App ()
assertBool String
"coturn username expiry should be in the future" (Integer -> POSIXTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (String -> Integer
forall a. Read a => String -> a
read String
expiryStr :: Integer) POSIXTime -> POSIXTime -> Bool
forall a. Ord a => a -> a -> Bool
> (POSIXTime
now :: POSIXTime))
        HasCallStack => String -> Bool -> App ()
String -> Bool -> App ()
assertBool String
"coturn username uid should be non-empty [a-z0-9]" ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Char
c -> Char -> Bool
isAsciiLower Char
c Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
c) String
uid' Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
uid'))
      (String, String)
_ -> String -> App ()
forall a. HasCallStack => String -> App a
assertFailure (String
"malformed coturn username: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
uname)
    cred <- ice %. "credential" & asString
    let expected = ByteString -> String
forall a b. ConvertibleStrings a b => a -> b
cs (ByteString -> ByteString
B64.encode (Digest -> ByteString -> ByteString -> ByteString
hmacBS Digest
sha1 ByteString
secret (String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs String
uname :: ByteString))) :: String
    -- Don't use 'shouldMatch' here: on mismatch it would print the real,
    -- usable coturn credential into test logs.
    assertBool "coturn credential mismatch" (cred == expected)

-- | multiple servers using files /calls/config/v3 - 200
--
-- Rewrites the turn v2 servers file watched by backendA's brig (config keys
-- 'turn.serversV2' and 'turn.coturnSecret') and verifies that the v3 endpoint
-- advertises exactly the file's servers with valid coturn native long-term
-- credentials.
testCallsConfigV3 :: (HasCallStack) => App ()
testCallsConfigV3 :: HasCallStack => App ()
testCallsConfigV3 = do
  -- Rewriting brig's watched turn-servers file and reading the coturn secret is
  -- only possible when brig runs locally (see 'servicesCwdBase'); when services
  -- run in containers their config is unreachable, so skip instead of failing.
  mServicesCwd <- (Env -> Maybe String) -> App (Maybe String)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.servicesCwdBase)
  case mServicesCwd of
    Maybe String
Nothing -> do
      name <- (Env -> String) -> App String
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"Test.Brig.testCallsConfigV3" (Maybe String -> String) -> (Env -> Maybe String) -> Env -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.currentTestName))
      putStrLn ("skipping " <> name <> ": turn file tests require locally running services")
    Just String
scwd -> do
      let brigCwd :: String
brigCwd = String
scwd String -> String -> String
</> String
"brig"
      cfg <- Service -> App Value
readServiceConfig Service
Brig
      serversV2Rel <- cfg %. "turn" %. "serversV2" & asString
      secretRel <- cfg %. "turn" %. "coturnSecret" & asString
      let serversV2 = String
brigCwd String -> String -> String
</> String
serversV2Rel
          secretAbs = String
brigCwd String -> String -> String
</> String
secretRel
      user <- randomUser OwnDomain def
      withModifiedTurnFile serversV2 $ \String -> App ()
updater -> do
        -- Ensure we have a clean config
        String -> App ()
updater String
"turn:localhost:3478"
        Value -> String -> [String] -> App ()
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> [String] -> App ()
assertV3Phase Value
user String
secretAbs [String
"turn:localhost:3478"]
        -- Change server list
        String -> App ()
updater String
"turn:localhost:3478\nturn:localhost:3479"
        Value -> String -> [String] -> App ()
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> [String] -> App ()
assertV3Phase Value
user String
secretAbs [String
"turn:localhost:3478", String
"turn:localhost:3479"]
        -- Revert the config file back to the original
        String -> App ()
updater String
"turn:localhost:3478"
        Value -> String -> [String] -> App ()
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> [String] -> App ()
assertV3Phase Value
user String
secretAbs [String
"turn:localhost:3478"]

assertV3Phase :: (HasCallStack) => (MakesValue user) => user -> FilePath -> [String] -> App ()
assertV3Phase :: forall user.
(HasCallStack, MakesValue user) =>
user -> String -> [String] -> App ()
assertV3Phase user
user String
secretAbs [String]
expected = do
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (user -> App Response
forall dom. (HasCallStack, MakesValue dom) => dom -> App Response
getCallsConfigV3 user
user) \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    iceServers <- Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"ice_servers" App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
    urls <- sort . concat <$> forM iceServers (\Value
e -> Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"urls" App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App [String]) -> App [String]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> App String) -> [Value] -> App [String]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString)
    urls `shouldMatch` sort expected
    body <- maybe (assertFailure "no response body") pure resp.json
    assertCoturnCredentials secretAbs body

testDeleteEmail :: (HasCallStack) => App ()
testDeleteEmail :: HasCallStack => App ()
testDeleteEmail = do
  (owner, tid, [usr]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  putSelf usr (PutSelf Nothing Nothing (Just "Alice") Nothing) >>= assertSuccess
  email <- getSelf usr >>= getJSON 200 >>= (%. "email") >>= asString

  let associateUsrWithSSO :: (HasCallStack) => App ()
      associateUsrWithSSO = do
        App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
owner String
tid String
"sso" String
"enabled"
        Value -> App Response
forall dom. (HasCallStack, MakesValue dom) => dom -> App Response
registerTestIdPWithMeta Value
owner App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
        tok <- Value -> CreateScimToken -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> CreateScimToken -> App Response
createScimTokenV6 Value
owner CreateScimToken
forall a. Default a => a
def App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200 App Value -> (Value -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"token") App Value -> (Value -> App String) -> App String
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
        void $ findUsersByExternalId owner tok email

      searchShouldBe :: (HasCallStack) => String -> App ()
      searchShouldBe String
expected = do
        Domain -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> App ()
BrigI.refreshIndex Domain
OwnDomain
        App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> App Response
BrigP.searchTeamWithSearchTerm Value
owner String
email) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
          Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
          numDocs <- [Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Value] -> Int) -> App [Value] -> App Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"documents" App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList)
          case expected of
            String
"empty" -> Int
numDocs Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
0
            String
"non-empty" -> Int
numDocs Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
1

  deleteSelfEmail usr >>= assertStatus 403
  searchShouldBe "non-empty"
  associateUsrWithSSO
  deleteSelfEmail usr >>= assertSuccess
  searchShouldBe "empty"