From dff3fc17d81b0d28673aa2acffca2f12abea4cff Mon Sep 17 00:00:00 2001 From: Stefan Berthold Date: Mon, 18 Mar 2024 16:44:45 +0000 Subject: [PATCH 01/12] create SFT token config --- services/brig/src/Brig/App.hs | 2 +- services/brig/src/Brig/Calling.hs | 24 +++++++++++++++++--- services/brig/src/Brig/Options.hs | 16 ++++++++++++- services/brig/test/unit/Test/Brig/Calling.hs | 3 ++- 4 files changed, 39 insertions(+), 6 deletions(-) diff --git a/services/brig/src/Brig/App.hs b/services/brig/src/Brig/App.hs index b9f5a099cfc..b2373c14efa 100644 --- a/services/brig/src/Brig/App.hs +++ b/services/brig/src/Brig/App.hs @@ -248,7 +248,7 @@ newEnv o = do eventsQueue <- case Opt.internalEventsQueue (Opt.internalEvents o) of StompQueue q -> pure (StompQueue q) SqsQueue q -> SqsQueue <$> AWS.getQueueUrl (aws ^. AWS.amazonkaEnv) q - mSFTEnv <- mapM Calling.mkSFTEnv $ Opt.sft o + mSFTEnv <- mapM (Calling.mkSFTEnv sha512) $ Opt.sft o prekeyLocalLock <- case Opt.randomPrekeys o of Just True -> do Log.info lgr $ Log.msg (Log.val "randomPrekeys: active") diff --git a/services/brig/src/Brig/Calling.hs b/services/brig/src/Brig/Calling.hs index 890531bd63a..49c79b0a9de 100644 --- a/services/brig/src/Brig/Calling.hs +++ b/services/brig/src/Brig/Calling.hs @@ -25,6 +25,7 @@ module Brig.Calling unSFTServers, mkSFTServers, SFTEnv (..), + SFTTokenEnv (..), Discovery (..), TurnEnv, TurnServers (..), @@ -133,7 +134,9 @@ data SFTEnv = SFTEnv sftDiscoveryInterval :: Int, -- | maximum amount of servers to give out, -- even if more are in the SRV record - sftListLength :: Range 1 100 Int + sftListLength :: Range 1 100 Int, + -- | token parameters + sftToken :: Maybe SFTTokenEnv } data Discovery a @@ -182,6 +185,13 @@ srvDiscoveryLoop domain discoveryInterval saveAction = forever $ do forM_ servers saveAction delay discoveryInterval +data SFTTokenEnv = SFTTokenEnv + { sftTokenTTL :: Word32, + sftTokenSecret :: ByteString, + sftTokenPRNG :: GenIO, + sftTokenSHA :: Digest + } + mkSFTDomain :: SFTOptions -> DNS.Domain mkSFTDomain SFTOptions {..} = DNS.normalize $ maybe defSftServiceName ("_" <>) sftSRVServiceName <> "._tcp." <> sftBaseDomain @@ -190,13 +200,21 @@ sftDiscoveryLoop SFTEnv {..} = srvDiscoveryLoop sftDomain sftDiscoveryInterval $ atomicWriteIORef sftServers . Discovered . SFTServers -mkSFTEnv :: SFTOptions -> IO SFTEnv -mkSFTEnv opts = +mkSFTEnv :: Digest -> SFTOptions -> IO SFTEnv +mkSFTEnv digest opts = SFTEnv <$> newIORef NotDiscoveredYet <*> pure (mkSFTDomain opts) <*> pure (diffTimeToMicroseconds (fromMaybe defSrvDiscoveryIntervalSeconds (Opts.sftDiscoveryIntervalSeconds opts))) <*> pure (fromMaybe defSftListLength (Opts.sftListLength opts)) + <*> forM (Opts.sftTokenOptions opts) (mkSFTTokenEnv digest) + +mkSFTTokenEnv :: Digest -> Opts.SFTTokenOptions -> IO SFTTokenEnv +mkSFTTokenEnv digest opts = + SFTTokenEnv (Opts.sttTTL opts) + <$> BS.readFile (Opts.sttSecret opts) + <*> createSystemRandom + <*> pure digest -- | Start SFT service discovery synchronously startSFTServiceDiscovery :: Log.Logger -> SFTEnv -> IO () diff --git a/services/brig/src/Brig/Options.hs b/services/brig/src/Brig/Options.hs index 027e1a1ec3e..12ea111f3f7 100644 --- a/services/brig/src/Brig/Options.hs +++ b/services/brig/src/Brig/Options.hs @@ -806,7 +806,8 @@ data SFTOptions = SFTOptions { sftBaseDomain :: !DNS.Domain, sftSRVServiceName :: !(Maybe ByteString), -- defaults to defSftServiceName if unset sftDiscoveryIntervalSeconds :: !(Maybe DiffTime), -- defaults to defSftDiscoveryIntervalSeconds - sftListLength :: !(Maybe (Range 1 100 Int)) -- defaults to defSftListLength + sftListLength :: !(Maybe (Range 1 100 Int)), -- defaults to defSftListLength + sftTokenOptions :: !(Maybe SFTTokenOptions) } deriving (Show, Generic) @@ -817,6 +818,19 @@ instance FromJSON SFTOptions where <*> (mapM asciiOnly =<< o .:? "sftSRVServiceName") <*> (secondsToDiffTime <$$> o .:? "sftDiscoveryIntervalSeconds") <*> (o .:? "sftListLength") + <*> (o .:? "sftToken") + +data SFTTokenOptions = SFTTokenOptions + { sttTTL :: !Word32, + sttSecret :: !FilePath + } + deriving (Show, Generic) + +instance FromJSON SFTTokenOptions where + parseJSON = Y.withObject "SFTTokenOptions" $ \o -> + SFTTokenOptions + <$> (o .: "ttl") + <*> (o .: "secret") asciiOnly :: Text -> Y.Parser ByteString asciiOnly t = diff --git a/services/brig/test/unit/Test/Brig/Calling.hs b/services/brig/test/unit/Test/Brig/Calling.hs index 044c289f9d1..8c5fc7844ae 100644 --- a/services/brig/test/unit/Test/Brig/Calling.hs +++ b/services/brig/test/unit/Test/Brig/Calling.hs @@ -126,7 +126,8 @@ testSFTDiscoveryLoopWhenSuccessful = do fakeDNSEnv <- newFakeDNSEnv (\_ -> SrvAvailable returnedEntries) let intervalInSeconds = 0.001 intervalInMicroseconds = 1000 - sftEnv <- mkSFTEnv $ SFTOptions "foo.example.com" Nothing (Just intervalInSeconds) Nothing + Just sha512 <- getDigestByName "SHA512" + sftEnv <- mkSFTEnv sha512 $ SFTOptions "foo.example.com" Nothing (Just intervalInSeconds) Nothing Nothing tick <- newEmptyMVar delayCallsTVar <- newTVarIO [] From 841832d5fed2df5867e9873111e4f2d9469575fd Mon Sep 17 00:00:00 2001 From: Stefan Berthold Date: Fri, 1 Mar 2024 16:58:26 +0000 Subject: [PATCH 02/12] create username and credential in sft_servers_all --- libs/wire-api/src/Wire/API/Call/Config.hs | 133 +++++++++++++++++- .../src/Wire/API/Routes/Public/Brig.hs | 16 +++ .../Golden/Generated/RTCConfiguration_user.hs | 81 ++++------- .../API/Golden/Generated/SFTServer_user.hs | 65 ++++----- .../testObject_RTCConfiguration_user_7.json | 4 +- .../golden/testObject_SFTServer_user_1.json | 4 +- services/brig/src/Brig/API/Public.hs | 1 + services/brig/src/Brig/Calling/API.hs | 87 +++++++++--- services/brig/test/integration/API/Calling.hs | 2 +- services/brig/test/unit/Test/Brig/Calling.hs | 25 ++-- 10 files changed, 291 insertions(+), 127 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Call/Config.hs b/libs/wire-api/src/Wire/API/Call/Config.hs index 18289ca1706..014448fc514 100644 --- a/libs/wire-api/src/Wire/API/Call/Config.hs +++ b/libs/wire-api/src/Wire/API/Call/Config.hs @@ -47,6 +47,15 @@ module Wire.API.Call.Config TurnHost (..), isHostName, + -- * SFTUsername + SFTUsername (SFTUsername), + mkSFTUsername, + suExpiresAt, + suVersion, + suKeyindex, + suS, + suRandom, + -- * TurnUsername TurnUsername, turnUsername, @@ -61,6 +70,14 @@ module Wire.API.Call.Config sftServer, sftURL, + -- * AuthSFTServer + AuthSFTServer, + authSFTServer, + nauthSFTServer, + authURL, + authUsername, + authCredential, + -- * convenience isUdp, isTcp, @@ -106,7 +123,7 @@ data RTCConfiguration = RTCConfiguration { _rtcConfIceServers :: NonEmpty RTCIceServer, _rtcConfSftServers :: Maybe (NonEmpty SFTServer), _rtcConfTTL :: Word32, - _rtcConfSftServersAll :: Maybe [SFTServer] + _rtcConfSftServersAll :: Maybe [AuthSFTServer] } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform RTCConfiguration) @@ -116,7 +133,7 @@ rtcConfiguration :: NonEmpty RTCIceServer -> Maybe (NonEmpty SFTServer) -> Word32 -> - Maybe [SFTServer] -> + Maybe [AuthSFTServer] -> RTCConfiguration rtcConfiguration = RTCConfiguration @@ -157,6 +174,39 @@ instance ToSchema SFTServer where sftServer :: HttpsUrl -> SFTServer sftServer = SFTServer +-------------------------------------------------------------------------------- +-- AuthSFTServer + +data AuthSFTServer = AuthSFTServer + { _authURL :: HttpsUrl, + _authUsername :: Maybe SFTUsername, + _authCredential :: Maybe AsciiBase64 + } + deriving stock (Eq, Show, Ord, Generic) + deriving (Arbitrary) via (GenericUniform AuthSFTServer) + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema AuthSFTServer) + +instance ToSchema AuthSFTServer where + schema = + objectWithDocModifier "SftServer" (description ?~ "Inspired by WebRTC 'RTCIceServer' object, contains details of SFT servers") $ + AuthSFTServer + <$> (pure . _authURL) + .= fieldWithDocModifier "urls" (description ?~ "Array containing exactly one SFT server address of the form 'https://:'") (withParser (array schema) p) + <*> _authUsername + .= maybe_ (optFieldWithDocModifier "username" (description ?~ "String containing the SFT username") schema) + <*> _authCredential + .= maybe_ (optFieldWithDocModifier "credential" (description ?~ "String containing the SFT credential") schema) + where + p :: [HttpsUrl] -> A.Parser HttpsUrl + p [url] = pure url + p xs = fail $ "SFTServer can only have exactly one URL, found " <> show (length xs) + +nauthSFTServer :: SFTServer -> AuthSFTServer +nauthSFTServer = (\u -> AuthSFTServer u Nothing Nothing) . _sftURL + +authSFTServer :: SFTServer -> SFTUsername -> AsciiBase64 -> AuthSFTServer +authSFTServer svr u = AuthSFTServer (_sftURL svr) (Just u) . Just + -------------------------------------------------------------------------------- -- RTCIceServer @@ -388,6 +438,83 @@ instance ToSchema Transport where element "tcp" TransportTCP ] +-------------------------------------------------------------------------------- +-- SFTUsername + +data SFTUsername = SFTUsername + { -- | must be positive, integral number of seconds + _suExpiresAt :: POSIXTime, + _suVersion :: Word, + -- | seems to large, but uint32_t is used in C + _suKeyindex :: Word32, + -- | whether the user is allowed to initialise an SFT conference + _suS :: Bool, + -- | [a-z0-9]+ + _suRandom :: Text + } + deriving stock (Eq, Ord, Show, Generic) + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema SFTUsername) + +-- note that the random value is not checked for well-formedness +mkSFTUsername :: POSIXTime -> Text -> SFTUsername +mkSFTUsername expires rnd = + SFTUsername + { _suExpiresAt = expires, + _suVersion = 1, + _suKeyindex = 0, + _suS = True, + _suRandom = rnd + } + +instance ToSchema SFTUsername where + schema = toText .= parsedText "" fromText + where + fromText :: Text -> Either String SFTUsername + fromText = parseOnly (parseSFTUsername <* endOfInput) + + toText :: SFTUsername -> Text + toText = cs . toByteString + +instance BC.ToByteString SFTUsername where + builder su = + shortByteString "d=" + <> word64Dec (round (_suExpiresAt su)) + <> shortByteString ".v=" + <> wordDec (_suVersion su) + <> shortByteString ".k=" + <> word32Dec (_suKeyindex su) + <> shortByteString ".s=" + <> wordDec (boolToWord $ _suS su) + <> shortByteString ".r=" + <> byteString (view (re utf8) (_suRandom su)) + where + boolToWord :: Num a => Bool -> a + boolToWord False = 0 + boolToWord True = 1 + +parseSFTUsername :: Text.Parser SFTUsername +parseSFTUsername = + SFTUsername + <$> (string "d=" *> fmap (fromIntegral :: Word64 -> POSIXTime) decimal) + <*> (string ".v=" *> decimal) + <*> (string ".k=" *> decimal) + <*> (string ".s=" *> (wordToBool <$> decimal)) + <*> (string ".r=" *> takeWhile1 (inClass "a-z0-9")) + where + wordToBool :: Word -> Bool + wordToBool = odd + +instance Arbitrary SFTUsername where + arbitrary = + SFTUsername + <$> (fromIntegral <$> arbitrary @Word64) + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> (Text.pack <$> QC.listOf1 genAlphaNum) + where + genAlphaNum = QC.elements $ ['a' .. 'z'] <> ['0' .. '9'] + -------------------------------------------------------------------------------- -- TurnUsername @@ -509,5 +636,7 @@ isTls uri = makeLenses ''RTCConfiguration makeLenses ''RTCIceServer makeLenses ''TurnURI +makeLenses ''SFTUsername makeLenses ''TurnUsername makeLenses ''SFTServer +makeLenses ''AuthSFTServer diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index 0cd23b3c3e3..f3b48803b85 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -1548,6 +1548,22 @@ type CallingAPI = :> QueryParam' '[Optional, Strict, Description "Limit resulting list. Allowed values [1..10]"] "limit" (Range 1 10 Int) :> Get '[JSON] RTCConfiguration ) + :<|> Named + "get-authenticated-calls-config" + ( Summary + "Retrieve all TURN server addresses and credentials. \ + \Clients are expected to do a DNS lookup to resolve \ + \the IP addresses of the given hostnames " + :> From 'V6 + :> ZUser + :> ZClient + :> ZConn + :> "calls" + :> "config" + :> "authenticated" + :> QueryParam' '[Optional, Strict, Description "Limit resulting list. Allowed values [1..10]"] "limit" (Range 1 10 Int) + :> Get '[JSON] RTCConfiguration + ) -- Teams API ----------------------------------------------------- diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/RTCConfiguration_user.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/RTCConfiguration_user.hs index 1a1414c6204..a02351591e6 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/RTCConfiguration_user.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/RTCConfiguration_user.hs @@ -19,46 +19,15 @@ module Test.Wire.API.Golden.Generated.RTCConfiguration_user where -import Control.Lens ((.~)) -import Data.Coerce (coerce) -import Data.List.NonEmpty (NonEmpty (..)) -import Data.Misc (HttpsUrl (HttpsUrl), IpAddr (IpAddr)) -import Data.Text.Ascii (AsciiChars (validate)) -import Data.Time (secondsToNominalDiffTime) -import Imports (Maybe (Just, Nothing), fromRight, read, undefined, (&)) +import Control.Lens +import Data.Coerce +import Data.List.NonEmpty +import Data.Misc +import Data.Text.Ascii +import Data.Time +import Imports import URI.ByteString - ( Authority - ( Authority, - authorityHost, - authorityPort, - authorityUserInfo - ), - Host (Host, hostBS), - Query (Query, queryPairs), - Scheme (Scheme, schemeBS), - URIRef - ( URI, - uriAuthority, - uriFragment, - uriPath, - uriQuery, - uriScheme - ), - ) import Wire.API.Call.Config - ( RTCConfiguration, - Scheme (SchemeTurn, SchemeTurns), - Transport (TransportTCP, TransportUDP), - TurnHost (TurnHostIp, TurnHostName), - rtcConfiguration, - rtcIceServer, - sftServer, - tuKeyindex, - tuT, - tuVersion, - turnURI, - turnUsername, - ) testObject_RTCConfiguration_user_1 :: RTCConfiguration testObject_RTCConfiguration_user_1 = @@ -758,22 +727,26 @@ testObject_RTCConfiguration_user_7 = Nothing 2 ( Just - [ sftServer - ( coerce - URI - { uriScheme = Scheme {schemeBS = "https"}, - uriAuthority = - Just - ( Authority - { authorityUserInfo = Nothing, - authorityHost = Host {hostBS = "example.com"}, - authorityPort = Nothing - } - ), - uriPath = "", - uriQuery = Query {queryPairs = []}, - uriFragment = Nothing - } + [ authSFTServer + ( sftServer + ( coerce + URI + { uriScheme = Scheme {schemeBS = "https"}, + uriAuthority = + Just + ( Authority + { authorityUserInfo = Nothing, + authorityHost = Host {hostBS = "example.com"}, + authorityPort = Nothing + } + ), + uriPath = "", + uriQuery = Query {queryPairs = []}, + uriFragment = Nothing + } + ) ) + (mkSFTUsername (secondsToNominalDiffTime 12) "username") + "credential" ] ) diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/SFTServer_user.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/SFTServer_user.hs index 535fd2683c5..b34fc94d32e 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/SFTServer_user.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/SFTServer_user.hs @@ -19,46 +19,33 @@ module Test.Wire.API.Golden.Generated.SFTServer_user where -import Data.Coerce (coerce) -import Data.Misc (HttpsUrl (HttpsUrl)) -import Imports (Maybe (Just, Nothing)) +import Data.Coerce +import Data.Misc +import Data.Time.Clock +import Imports import URI.ByteString - ( Authority - ( Authority, - authorityHost, - authorityPort, - authorityUserInfo - ), - Host (Host, hostBS), - Query (Query, queryPairs), - Scheme (Scheme, schemeBS), - URIRef - ( URI, - uriAuthority, - uriFragment, - uriPath, - uriQuery, - uriScheme - ), - ) -import Wire.API.Call.Config (SFTServer, sftServer) +import Wire.API.Call.Config -testObject_SFTServer_user_1 :: SFTServer +testObject_SFTServer_user_1 :: AuthSFTServer testObject_SFTServer_user_1 = - sftServer - ( coerce - URI - { uriScheme = Scheme {schemeBS = "https"}, - uriAuthority = - Just - ( Authority - { authorityUserInfo = Nothing, - authorityHost = Host {hostBS = "example.com"}, - authorityPort = Nothing - } - ), - uriPath = "", - uriQuery = Query {queryPairs = []}, - uriFragment = Nothing - } + authSFTServer + ( sftServer + ( coerce + URI + { uriScheme = Scheme {schemeBS = "https"}, + uriAuthority = + Just + ( Authority + { authorityUserInfo = Nothing, + authorityHost = Host {hostBS = "example.com"}, + authorityPort = Nothing + } + ), + uriPath = "", + uriQuery = Query {queryPairs = []}, + uriFragment = Nothing + } + ) ) + (mkSFTUsername (secondsToNominalDiffTime 12) "username") + "credential" diff --git a/libs/wire-api/test/golden/testObject_RTCConfiguration_user_7.json b/libs/wire-api/test/golden/testObject_RTCConfiguration_user_7.json index 8e9fa8b7808..bdd7b330834 100644 --- a/libs/wire-api/test/golden/testObject_RTCConfiguration_user_7.json +++ b/libs/wire-api/test/golden/testObject_RTCConfiguration_user_7.json @@ -13,9 +13,11 @@ ], "sft_servers_all": [ { + "credential": "credential", "urls": [ "https://example.com" - ] + ], + "username": "d=12.v=1.k=0.s=1.r=username" } ], "ttl": 2 diff --git a/libs/wire-api/test/golden/testObject_SFTServer_user_1.json b/libs/wire-api/test/golden/testObject_SFTServer_user_1.json index 957a0ccbff7..1e2fbf7a23d 100644 --- a/libs/wire-api/test/golden/testObject_SFTServer_user_1.json +++ b/libs/wire-api/test/golden/testObject_SFTServer_user_1.json @@ -1,5 +1,7 @@ { + "credential": "credential", "urls": [ "https://example.com" - ] + ], + "username": "d=12.v=1.k=0.s=1.r=username" } diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index 0a4137e24b7..14456e0bcdd 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -436,6 +436,7 @@ servantSitemap = callingAPI = Named @"get-calls-config" Calling.getCallsConfig :<|> Named @"get-calls-config-v2" Calling.getCallsConfigV2 + :<|> Named @"get-authenticated-calls-config" Calling.getAuthenticatedCallsConfig systemSettingsAPI :: ServerT SystemSettingsAPI (Handler r) systemSettingsAPI = diff --git a/services/brig/src/Brig/Calling/API.hs b/services/brig/src/Brig/Calling/API.hs index 90998b1fb3a..fdd98fa7429 100644 --- a/services/brig/src/Brig/Calling/API.hs +++ b/services/brig/src/Brig/Calling/API.hs @@ -1,4 +1,5 @@ {-# LANGUAGE BlockArguments #-} +{-# LANGUAGE RecordWildCards #-} -- This file is part of the Wire Server implementation. -- @@ -48,20 +49,59 @@ import Data.Misc (HttpsUrl) import Data.Range import Data.Text.Ascii (AsciiBase64, encodeBase64) import Data.Text.Strict.Lens -import Data.Time.Clock.POSIX (getPOSIXTime) +import Data.Time.Clock.POSIX import Imports hiding (head) import OpenSSL.EVP.Digest (Digest, hmacBS) import Polysemy import Polysemy.Error qualified as Polysemy import System.Logger.Class qualified as Log import System.Random.MWC qualified as MWC -import Wire.API.Call.Config (SFTServer) import Wire.API.Call.Config qualified as Public import Wire.Network.DNS.SRV (srvTarget) import Wire.Sem.Logger.TinyLog (loggerToTinyLog) -- | ('UserId', 'ConnId' are required as args here to make sure this is an authenticated end-point.) -getCallsConfigV2 :: UserId -> ConnId -> Maybe (Range 1 10 Int) -> (Handler r) Public.RTCConfiguration +getAuthenticatedCallsConfig :: + ( Member (Embed IO) r, + Member SFT r, + Member SFTStore r + ) => + UserId -> + ClientId -> + ConnId -> + Maybe (Range 1 10 Int) -> + (Handler r) Public.RTCConfiguration +getAuthenticatedCallsConfig u c _ limit = do + env <- view turnEnv + staticUrl <- view $ settings . Opt.sftStaticUrl + sftListAllServers <- fromMaybe Opt.HideAllSFTServers <$> view (settings . Opt.sftListAllServers) + sftEnv' <- view sftEnv + enableFederation' <- view enableFederation + discoveredServers <- turnServersV2 (env ^. turnServers) + eitherConfig <- + lift + . liftSem + . Polysemy.runError + $ newConfig + env + discoveredServers + staticUrl + sftEnv' + limit + sftListAllServers + (AuthenticatedCallsConfig u c enableFederation') + handleNoTurnServers eitherConfig + +-- | ('UserId', 'ConnId' are required as args here to make sure this is an authenticated end-point.) +getCallsConfigV2 :: + ( Member (Embed IO) r, + Member SFT r, + Member SFTStore r + ) => + UserId -> + ConnId -> + Maybe (Range 1 10 Int) -> + (Handler r) Public.RTCConfiguration getCallsConfigV2 _ _ limit = do env <- view turnEnv staticUrl <- view $ settings . Opt.sftStaticUrl @@ -139,7 +179,6 @@ newConfig :: CallsConfigVersion -> Sem r Public.RTCConfiguration newConfig env discoveredServers sftStaticUrl mSftEnv limit listAllServers version = do - let (sha, secret, tTTL, cTTL, prng) = (env ^. turnSHA512, env ^. turnSecret, env ^. turnTokenTTL, env ^. turnConfigTTL, env ^. turnPrng) -- randomize list of servers (before limiting the list, to ensure not always the same servers are chosen if limit is set) randomizedUris <- liftIO . randomize @@ -150,8 +189,8 @@ newConfig env discoveredServers sftStaticUrl mSftEnv limit listAllServers versio -- randomize again (as limitedList partially re-orders uris) finalUris <- liftIO $ randomize limitedUris srvs <- for finalUris $ \uri -> do - u <- liftIO $ genUsername tTTL prng - pure $ Public.rtcIceServer (pure uri) u (computeCred sha secret u) + u <- liftIO $ genTurnUsername (env ^. turnTokenTTL) (env ^. turnPrng) + pure . Public.rtcIceServer (pure uri) u $ computeCred (env ^. turnSHA512) (env ^. turnSecret) u let staticSft = pure . Public.sftServer <$> sftStaticUrl allSrvEntries <- @@ -163,16 +202,17 @@ newConfig env discoveredServers sftStaticUrl mSftEnv limit listAllServers versio let subsetLength = Calling.sftListLength actualSftEnv mapM (getRandomElements subsetLength) allSrvEntries - mSftServersAll :: Maybe [SFTServer] <- case version of - CallsConfigDeprecated -> pure Nothing - CallsConfigV2 -> - case (listAllServers, sftStaticUrl) of - (HideAllSFTServers, _) -> pure Nothing - (ListAllSFTServers, Nothing) -> pure . Just $ sftServerFromSrvTarget . srvTarget <$> maybe [] toList allSrvEntries - (ListAllSFTServers, Just url) -> hush . unSFTGetResponse <$> sftGetAllServers url + mSftServersAll <- + mapM (mapM authenticate) =<< case version of + CallsConfigDeprecated -> pure Nothing + CallsConfigV2 -> + case (listAllServers, sftStaticUrl) of + (HideAllSFTServers, _) -> pure Nothing + (ListAllSFTServers, Nothing) -> pure . Just $ sftServerFromSrvTarget . srvTarget <$> maybe [] toList allSrvEntries + (ListAllSFTServers, Just url) -> hush . unSFTGetResponse <$> sftGetAllServers url let mSftServers = staticSft <|> sftServerFromSrvTarget . srvTarget <$$> srvEntries - pure $ Public.rtcConfiguration srvs mSftServers cTTL mSftServersAll + pure $ Public.rtcConfiguration srvs mSftServers (env ^. turnConfigTTL) mSftServersAll where limitedList :: NonEmpty Public.TurnURI -> Range 1 10 Int -> NonEmpty Public.TurnURI limitedList uris lim = @@ -182,10 +222,23 @@ newConfig env discoveredServers sftStaticUrl mSftEnv limit listAllServers versio -- it should also be safe to assume the returning list has length >= 1 NonEmpty.nonEmpty (Public.limitServers (NonEmpty.toList uris) (fromRange lim)) & fromMaybe (error "newConfig:limitedList: empty list of servers") - genUsername :: Word32 -> MWC.GenIO -> IO Public.TurnUsername + genUsername :: Word32 -> MWC.GenIO -> IO (POSIXTime, Text) genUsername ttl prng = do rnd <- view (packedBytes . utf8) <$> replicateM 16 (MWC.uniformR (97, 122) prng) t <- fromIntegral . (+ ttl) . round <$> getPOSIXTime - pure $ Public.turnUsername t rnd - computeCred :: Digest -> ByteString -> Public.TurnUsername -> AsciiBase64 + pure $ (t, rnd) + genTurnUsername :: Word32 -> MWC.GenIO -> IO Public.TurnUsername + genTurnUsername = (fmap (uncurry Public.turnUsername) .) . genUsername + genSFTUsername :: Word32 -> MWC.GenIO -> IO Public.SFTUsername + genSFTUsername = (fmap (uncurry Public.mkSFTUsername) .) . genUsername + computeCred :: ToByteString a => Digest -> ByteString -> a -> AsciiBase64 computeCred dig secret = encodeBase64 . hmacBS dig secret . toByteString' + authenticate :: Member (Embed IO) r => Public.SFTServer -> Sem r Public.SFTServer + authenticate = + maybe + pure + ( \SFTTokenEnv {..} sftsvr -> do + u <- liftIO $ genSFTUsername sftTokenTTL sftTokenPRNG + pure $ Public.authSFTServer (sftsvr ^. Public.sftURL) u (computeCred sftTokenSHA sftTokenSecret u) + ) + (sftToken =<< mSftEnv) diff --git a/services/brig/test/integration/API/Calling.hs b/services/brig/test/integration/API/Calling.hs index ffcaad9399f..b6a355b1264 100644 --- a/services/brig/test/integration/API/Calling.hs +++ b/services/brig/test/integration/API/Calling.hs @@ -101,7 +101,7 @@ testSFT b opts = do "when SFT discovery is not enabled, sft_servers shouldn't be returned" Nothing (cfg ^. rtcConfSftServers) - withSettingsOverrides (opts & Opts.sftL ?~ Opts.SFTOptions "integration-tests.zinfra.io" Nothing (Just 0.001) Nothing) $ do + withSettingsOverrides (opts & Opts.sftL ?~ Opts.SFTOptions "integration-tests.zinfra.io" Nothing (Just 0.001) Nothing Nothing) $ do cfg1 <- retryWhileN 10 (isNothing . view rtcConfSftServers) (getTurnConfigurationV2 uid b) -- These values are controlled by https://github.com/zinfra/cailleach/tree/77ca2d23cf2959aa183dd945d0a0b13537a8950d/environments/dns-integration-tests let Right server1 = mkHttpsUrl =<< first show (parseURI laxURIParserOptions "https://sft01.integration-tests.zinfra.io:443") diff --git a/services/brig/test/unit/Test/Brig/Calling.hs b/services/brig/test/unit/Test/Brig/Calling.hs index 8c5fc7844ae..77826de1593 100644 --- a/services/brig/test/unit/Test/Brig/Calling.hs +++ b/services/brig/test/unit/Test/Brig/Calling.hs @@ -21,13 +21,13 @@ module Test.Brig.Calling (tests) where import Brig.Calling -import Brig.Calling.API (CallsConfigVersion (..), NoTurnServers, newConfig) -import Brig.Calling.Internal (sftServerFromSrvTarget) +import Brig.Calling.API +import Brig.Calling.Internal import Brig.Effects.SFT import Brig.Options import Control.Concurrent.Timeout qualified as System import Control.Lens ((^.)) -import Control.Monad.Catch (throwM) +import Control.Monad.Catch import Data.Bifunctor import Data.List.NonEmpty (NonEmpty (..)) import Data.List.NonEmpty qualified as NonEmpty @@ -39,14 +39,14 @@ import Data.Timeout import Imports import Network.DNS import OpenSSL -import OpenSSL.EVP.Digest (getDigestByName) +import OpenSSL.EVP.Digest import Polysemy import Polysemy.Error import Polysemy.TinyLog import Test.Brig.Effects.Delay import Test.Tasty import Test.Tasty.HUnit -import Test.Tasty.QuickCheck (Arbitrary (..), generate) +import Test.Tasty.QuickCheck import URI.ByteString import UnliftIO.Async qualified as Async import Wire.API.Call.Config @@ -83,12 +83,12 @@ tests = assertEqual "should use the service name to form domain" "_foo._tcp.example.com." - (mkSFTDomain (SFTOptions "example.com" (Just "foo") Nothing Nothing)), + (mkSFTDomain (SFTOptions "example.com" (Just "foo") Nothing Nothing Nothing)), testCase "when service name is not provided" $ assertEqual "should assume service name to be 'sft'" "_sft._tcp.example.com." - (mkSFTDomain (SFTOptions "example.com" Nothing Nothing Nothing)) + (mkSFTDomain (SFTOptions "example.com" Nothing Nothing Nothing Nothing)) ], testGroup "sftDiscoveryLoop" $ [ testCase "when service can be discovered" $ void testSFTDiscoveryLoopWhenSuccessful @@ -316,6 +316,7 @@ testSFTStaticV2NoStaticUrl = do <*> pure "foo.example.com" <*> pure 5 <*> pure (unsafeRange 1) + <*> pure Nothing turnUri <- generate arbitrary cfg <- runM @IO @@ -325,8 +326,8 @@ testSFTStaticV2NoStaticUrl = do $ newConfig env (Discovered turnUri) Nothing (Just sftEnv) (Just . unsafeRange $ 2) ListAllSFTServers CallsConfigV2 assertEqual "when SFT static URL is disabled, sft_servers_all should be from SFT environment" - (Just . fmap (sftServerFromSrvTarget . srvTarget) . toList $ servers) - (cfg ^. rtcConfSftServersAll) + (Just . fmap ((^. sftURL) . sftServerFromSrvTarget . srvTarget) . toList $ servers) + ((^. authURL) <$$> cfg ^. rtcConfSftServersAll) -- The v2 endpoint `GET /calls/config/v2` with an SFT static URL that gives an error testSFTStaticV2StaticUrlError :: IO () @@ -355,13 +356,13 @@ testSFTStaticV2StaticUrlList = do cfg <- runM @IO . ignoreLogs - . interpretSFTInMemory (Map.singleton staticUrl (SFTGetResponse . Right $ servers)) + . interpretSFTInMemory (Map.singleton staticUrl (SFTGetResponse $ Right servers)) . throwErrorInIO @_ @NoTurnServers $ newConfig env (Discovered turnUri) (Just staticUrl) Nothing (Just . unsafeRange $ 3) ListAllSFTServers CallsConfigV2 assertEqual "when SFT static URL and setSftListAllServers are enabled, sft_servers_all should be from /sft_servers_all.json" - (Just servers) - (cfg ^. rtcConfSftServersAll) + ((^. sftURL) <$$> Just servers) + ((^. authURL) <$$> cfg ^. rtcConfSftServersAll) testSFTStaticV2ListAllServersDisabled :: IO () testSFTStaticV2ListAllServersDisabled = do From cb07c490ae53e1637f4d57fde19a55d3c4984ba8 Mon Sep 17 00:00:00 2001 From: Stefan Berthold Date: Fri, 22 Mar 2024 09:57:12 +0000 Subject: [PATCH 03/12] rate-limit new credentials by user --- cassandra-schema.cql | 26 +++++ services/brig/brig.cabal | 3 + services/brig/src/Brig/API/Public.hs | 21 ++-- services/brig/src/Brig/Calling.hs | 4 +- services/brig/src/Brig/Calling/API.hs | 68 +++++++---- .../brig/src/Brig/CanonicalInterpreter.hs | 9 +- services/brig/src/Brig/Effects/SFTStore.hs | 40 +++++++ .../src/Brig/Effects/SFTStore/Cassandra.hs | 108 ++++++++++++++++++ services/brig/src/Brig/Options.hs | 4 +- services/brig/src/Brig/Schema/Run.hs | 4 +- .../src/Brig/Schema/V82_AddSFTCredentials.hs | 44 +++++++ services/brig/test/unit/Test/Brig/Calling.hs | 6 + .../src/Galley/Cassandra/Conversation/MLS.hs | 3 +- 13 files changed, 304 insertions(+), 36 deletions(-) create mode 100644 services/brig/src/Brig/Effects/SFTStore.hs create mode 100644 services/brig/src/Brig/Effects/SFTStore/Cassandra.hs create mode 100644 services/brig/src/Brig/Schema/V82_AddSFTCredentials.hs diff --git a/cassandra-schema.cql b/cassandra-schema.cql index a35870fedfd..98642464aa4 100644 --- a/cassandra-schema.cql +++ b/cassandra-schema.cql @@ -789,6 +789,32 @@ CREATE TABLE brig_test.prekeys ( AND read_repair_chance = 0.0 AND speculative_retry = '99PERCENTILE'; +CREATE TABLE brig_test.sft_credential ( + user uuid, + client text, + credential ascii, + expiry varint, + key_index bigint, + random text, + s boolean, + version bigint, + PRIMARY KEY (user, client) +) WITH CLUSTERING ORDER BY (client ASC) + AND bloom_filter_fp_chance = 0.01 + AND caching = {'keys': 'ALL', 'rows_per_partition': 'NONE'} + AND comment = '' + AND compaction = {'class': 'org.apache.cassandra.db.compaction.SizeTieredCompactionStrategy', 'max_threshold': '32', 'min_threshold': '4'} + AND compression = {'chunk_length_in_kb': '64', 'class': 'org.apache.cassandra.io.compress.LZ4Compressor'} + AND crc_check_chance = 1.0 + AND dclocal_read_repair_chance = 0.1 + AND default_time_to_live = 0 + AND gc_grace_seconds = 864000 + AND max_index_interval = 2048 + AND memtable_flush_period_in_ms = 0 + AND min_index_interval = 128 + AND read_repair_chance = 0.0 + AND speculative_retry = '99PERCENTILE'; + CREATE TABLE brig_test.oauth_auth_code ( code ascii PRIMARY KEY, client uuid, diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal index 4e0c272153d..2486e7ce081 100644 --- a/services/brig/brig.cabal +++ b/services/brig/brig.cabal @@ -136,6 +136,8 @@ library Brig.Effects.PasswordResetStore.CodeStore Brig.Effects.PublicKeyBundle Brig.Effects.SFT + Brig.Effects.SFTStore + Brig.Effects.SFTStore.Cassandra Brig.Effects.UserPendingActivationStore Brig.Effects.UserPendingActivationStore.Cassandra Brig.Email @@ -203,6 +205,7 @@ library Brig.Schema.V79_ConnectionRemoteIndex Brig.Schema.V80_KeyPackageCiphersuite Brig.Schema.V81_AddFederationRemoteTeams + Brig.Schema.V82_AddSFTCredentials Brig.Schema.V_FUTUREWORK Brig.SMTP Brig.Team.API diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index 14456e0bcdd..a3ef72981fc 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -55,6 +55,8 @@ import Brig.Effects.GalleyProvider qualified as GalleyProvider import Brig.Effects.JwtTools (JwtTools) import Brig.Effects.PasswordResetStore (PasswordResetStore) import Brig.Effects.PublicKeyBundle (PublicKeyBundle) +import Brig.Effects.SFT +import Brig.Effects.SFTStore import Brig.Effects.UserPendingActivationStore (UserPendingActivationStore) import Brig.Options hiding (internalEvents, sesQueue) import Brig.Provider.API @@ -270,20 +272,23 @@ servantSitemap :: Member BlacklistStore r, Member CodeStore r, Member (Concurrency 'Unsafe) r, + Member (ConnectionStore InternalPaging) r, + Member (Embed HttpClientIO) r, + Member (Embed IO) r, + Member FederationConfigStore r, Member GalleyProvider r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member Jwk r, Member JwtTools r, + Member NotificationSubsystem r, Member Now r, Member PasswordResetStore r, Member PublicKeyBundle r, - Member (UserPendingActivationStore p) r, - Member Jwk r, - Member FederationConfigStore r, - Member (Embed HttpClientIO) r, - Member NotificationSubsystem r, + Member SFT r, + Member SFTStore r, Member TinyLog r, - Member (Input (Local ())) r, - Member (Input UTCTime) r, - Member (ConnectionStore InternalPaging) r + Member (UserPendingActivationStore p) r ) => ServerT BrigAPI (Handler r) servantSitemap = diff --git a/services/brig/src/Brig/Calling.hs b/services/brig/src/Brig/Calling.hs index 49c79b0a9de..da1c183d4d7 100644 --- a/services/brig/src/Brig/Calling.hs +++ b/services/brig/src/Brig/Calling.hs @@ -189,7 +189,8 @@ data SFTTokenEnv = SFTTokenEnv { sftTokenTTL :: Word32, sftTokenSecret :: ByteString, sftTokenPRNG :: GenIO, - sftTokenSHA :: Digest + sftTokenSHA :: Digest, + sftTokenSecondsBeforeNew :: Int32 } mkSFTDomain :: SFTOptions -> DNS.Domain @@ -215,6 +216,7 @@ mkSFTTokenEnv digest opts = <$> BS.readFile (Opts.sttSecret opts) <*> createSystemRandom <*> pure digest + <*> pure (Opts.sttSecondsBeforeNew opts) -- | Start SFT service discovery synchronously startSFTServiceDiscovery :: Log.Logger -> SFTEnv -> IO () diff --git a/services/brig/src/Brig/Calling/API.hs b/services/brig/src/Brig/Calling/API.hs index fdd98fa7429..ac09c99273b 100644 --- a/services/brig/src/Brig/Calling/API.hs +++ b/services/brig/src/Brig/Calling/API.hs @@ -21,6 +21,7 @@ module Brig.Calling.API ( getCallsConfig, getCallsConfigV2, + getAuthenticatedCallsConfig, -- * Exposed for testing purposes newConfig, @@ -36,6 +37,7 @@ import Brig.Calling import Brig.Calling qualified as Calling import Brig.Calling.Internal import Brig.Effects.SFT +import Brig.Effects.SFTStore import Brig.Options (ListAllSFTServers (..)) import Brig.Options qualified as Opt import Control.Error (hush, throwE) @@ -58,7 +60,6 @@ import System.Logger.Class qualified as Log import System.Random.MWC qualified as MWC import Wire.API.Call.Config qualified as Public import Wire.Network.DNS.SRV (srvTarget) -import Wire.Sem.Logger.TinyLog (loggerToTinyLog) -- | ('UserId', 'ConnId' are required as args here to make sure this is an authenticated end-point.) getAuthenticatedCallsConfig :: @@ -107,14 +108,10 @@ getCallsConfigV2 _ _ limit = do staticUrl <- view $ settings . Opt.sftStaticUrl sftListAllServers <- fromMaybe Opt.HideAllSFTServers <$> view (settings . Opt.sftListAllServers) sftEnv' <- view sftEnv - logger <- view applog - manager <- view httpManager discoveredServers <- turnServersV2 (env ^. turnServers) eitherConfig <- - liftIO - . runM @IO - . loggerToTinyLog logger - . interpretSFT manager + lift + . liftSem . Polysemy.runError $ newConfig env discoveredServers staticUrl sftEnv' limit sftListAllServers CallsConfigV2 handleNoTurnServers eitherConfig @@ -131,18 +128,21 @@ handleNoTurnServers (Left NoTurnServers) = do Log.err $ Log.msg (Log.val "Call config requested before TURN URIs could be discovered.") throwE $ StdError internalServerError -getCallsConfig :: UserId -> ConnId -> (Handler r) Public.RTCConfiguration +getCallsConfig :: + ( Member (Embed IO) r, + Member SFT r, + Member SFTStore r + ) => + UserId -> + ConnId -> + (Handler r) Public.RTCConfiguration getCallsConfig _ _ = do env <- view turnEnv - logger <- view applog - manager <- view httpManager discoveredServers <- turnServersV1 (env ^. turnServers) eitherConfig <- (dropTransport <$$>) - . liftIO - . runM @IO - . loggerToTinyLog logger - . interpretSFT manager + . lift + . liftSem . Polysemy.runError $ newConfig env discoveredServers Nothing Nothing Nothing HideAllSFTServers CallsConfigDeprecated handleNoTurnServers eitherConfig @@ -157,6 +157,7 @@ getCallsConfig _ _ = do data CallsConfigVersion = CallsConfigDeprecated | CallsConfigV2 + | AuthenticatedCallsConfig UserId ClientId data NoTurnServers = NoTurnServers deriving (Show) @@ -169,7 +170,11 @@ instance Exception NoTurnServers -- to be set or only one of them (perhaps Data.These combined with error -- handling). newConfig :: - Members [Embed IO, SFT, Polysemy.Error NoTurnServers] r => + ( Member (Embed IO) r, + Member SFT r, + Member SFTStore r, + Member (Polysemy.Error NoTurnServers) r + ) => Calling.TurnEnv -> Discovery (NonEmpty Public.TurnURI) -> Maybe HttpsUrl -> @@ -203,13 +208,18 @@ newConfig env discoveredServers sftStaticUrl mSftEnv limit listAllServers versio mapM (getRandomElements subsetLength) allSrvEntries mSftServersAll <- - mapM (mapM authenticate) =<< case version of + case version of CallsConfigDeprecated -> pure Nothing CallsConfigV2 -> case (listAllServers, sftStaticUrl) of (HideAllSFTServers, _) -> pure Nothing - (ListAllSFTServers, Nothing) -> pure . Just $ sftServerFromSrvTarget . srvTarget <$> maybe [] toList allSrvEntries - (ListAllSFTServers, Just url) -> hush . unSFTGetResponse <$> sftGetAllServers url + (ListAllSFTServers, Nothing) -> pure . pure $ Public.nauthSFTServer . sftServerFromSrvTarget . srvTarget <$> maybe [] toList allSrvEntries + (ListAllSFTServers, Just url) -> Public.nauthSFTServer <$$$> (hush . unSFTGetResponse <$> sftGetAllServers url) + AuthenticatedCallsConfig u c -> + case (listAllServers, sftStaticUrl) of + (HideAllSFTServers, _) -> pure Nothing + (ListAllSFTServers, Nothing) -> mapM (mapM $ authenticate u c) . pure $ sftServerFromSrvTarget . srvTarget <$> maybe [] toList allSrvEntries + (ListAllSFTServers, Just url) -> mapM (mapM $ authenticate u c) . hush . unSFTGetResponse =<< sftGetAllServers url let mSftServers = staticSft <|> sftServerFromSrvTarget . srvTarget <$$> srvEntries pure $ Public.rtcConfiguration srvs mSftServers (env ^. turnConfigTTL) mSftServersAll @@ -233,12 +243,24 @@ newConfig env discoveredServers sftStaticUrl mSftEnv limit listAllServers versio genSFTUsername = (fmap (uncurry Public.mkSFTUsername) .) . genUsername computeCred :: ToByteString a => Digest -> ByteString -> a -> AsciiBase64 computeCred dig secret = encodeBase64 . hmacBS dig secret . toByteString' - authenticate :: Member (Embed IO) r => Public.SFTServer -> Sem r Public.SFTServer - authenticate = + authenticate :: + ( Member (Embed IO) r, + Member SFTStore r + ) => + UserId -> + ClientId -> + Public.SFTServer -> + Sem r Public.AuthSFTServer + authenticate u c = maybe - pure + (pure . Public.nauthSFTServer) ( \SFTTokenEnv {..} sftsvr -> do - u <- liftIO $ genSFTUsername sftTokenTTL sftTokenPRNG - pure $ Public.authSFTServer (sftsvr ^. Public.sftURL) u (computeCred sftTokenSHA sftTokenSecret u) + username <- liftIO $ genSFTUsername sftTokenTTL sftTokenPRNG + let credential = computeCred sftTokenSHA sftTokenSecret username + void $ sftStoreCredential u c username credential sftTokenSecondsBeforeNew + maybe + (Public.nauthSFTServer sftsvr) + (uncurry (Public.authSFTServer sftsvr)) + <$> sftGetCredential u c ) (sftToken =<< mSftEnv) diff --git a/services/brig/src/Brig/CanonicalInterpreter.hs b/services/brig/src/Brig/CanonicalInterpreter.hs index 9a77bbae6dc..18b0a877937 100644 --- a/services/brig/src/Brig/CanonicalInterpreter.hs +++ b/services/brig/src/Brig/CanonicalInterpreter.hs @@ -17,6 +17,9 @@ import Brig.Effects.JwtTools import Brig.Effects.PasswordResetStore (PasswordResetStore) import Brig.Effects.PasswordResetStore.CodeStore (passwordResetStoreToCodeStore) import Brig.Effects.PublicKeyBundle +import Brig.Effects.SFT (SFT, interpretSFT) +import Brig.Effects.SFTStore +import Brig.Effects.SFTStore.Cassandra import Brig.Effects.UserPendingActivationStore (UserPendingActivationStore) import Brig.Effects.UserPendingActivationStore.Cassandra (userPendingActivationStoreToCassandra) import Brig.Options (ImplicitNoFederationRestriction (federationDomainConfig), federationDomainConfigs, federationStrategy) @@ -49,7 +52,9 @@ import Wire.Sem.Now.IO (nowToIOAction) import Wire.Sem.Paging.Cassandra (InternalPaging) type BrigCanonicalEffects = - '[ ConnectionStore InternalPaging, + '[ SFT, + SFTStore, + ConnectionStore InternalPaging, Input UTCTime, Input (Local ()), NotificationSubsystem, @@ -110,6 +115,8 @@ runBrigToIO e (AppT ma) = do . runInputConst (toLocalUnsafe (e ^. settings . Opt.federationDomain) ()) . runInputSem (embed getCurrentTime) . connectionStoreToCassandra + . interpretSFTStoreToCassandra + . interpretSFT (e ^. httpManager) ) ) $ runReaderT ma e diff --git a/services/brig/src/Brig/Effects/SFTStore.hs b/services/brig/src/Brig/Effects/SFTStore.hs new file mode 100644 index 00000000000..aedaccdfc5a --- /dev/null +++ b/services/brig/src/Brig/Effects/SFTStore.hs @@ -0,0 +1,40 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2024 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 . +{-# LANGUAGE TemplateHaskell #-} + +module Brig.Effects.SFTStore where + +import Data.Id +import Data.Text.Ascii +import Imports +import Polysemy +import Wire.API.Call.Config + +data SFTStore m a where + SftStoreCredential :: + UserId -> + ClientId -> + SFTUsername -> + AsciiBase64 -> + Int32 -> + SFTStore m Bool + SftGetCredential :: + UserId -> + ClientId -> + SFTStore m (Maybe (SFTUsername, AsciiBase64)) + +makeSem ''SFTStore diff --git a/services/brig/src/Brig/Effects/SFTStore/Cassandra.hs b/services/brig/src/Brig/Effects/SFTStore/Cassandra.hs new file mode 100644 index 00000000000..3da67157827 --- /dev/null +++ b/services/brig/src/Brig/Effects/SFTStore/Cassandra.hs @@ -0,0 +1,108 @@ +{-# LANGUAGE DeepSubsumption #-} + +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2024 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.Effects.SFTStore.Cassandra + ( interpretSFTStoreToCassandra, + interpretSFTStoreToConstant, + ) +where + +import Brig.Effects.SFTStore +import Cassandra +import Cassandra.Settings +import Control.Error +import Control.Lens ((^.)) +import Data.Id +import Data.Text.Ascii +import Data.Time.Clock +import Imports +import Polysemy +import Polysemy.Internal.Tactics +import Wire.API.Call.Config + +interpretSFTStoreToCassandra :: + forall r a. + (Member (Embed Client) r) => + Sem (SFTStore ': r) a -> + Sem r a +interpretSFTStoreToCassandra = + interpretH $ + liftT . embed @Client . \case + SftStoreCredential u c username credential ttl -> storeCredential u c username credential ttl + SftGetCredential u c -> getCredential u c + +interpretSFTStoreToConstant :: + forall r a. + Sem (SFTStore ': r) a -> + Sem r a +interpretSFTStoreToConstant = + interpretH $ + liftT . \case + SftStoreCredential _u _c _username _credential _ttl -> pure True + SftGetCredential _u _c -> pure $ Just (mkSFTUsername 12 "username", "credential") + +checkTransSuccess :: [Row] -> Bool +checkTransSuccess [] = False +checkTransSuccess (row : _) = fromMaybe False . hush $ fromRow 0 row + +storeCredential :: MonadClient m => UserId -> ClientId -> SFTUsername -> AsciiBase64 -> Int32 -> m Bool +storeCredential u c username credential ttl = + checkTransSuccess + <$> retry + x5 + ( trans + addCredential + ( params + LocalQuorum + ( u, + c, + floor $ nominalDiffTimeToSeconds (username ^. suExpiresAt), + fromIntegral (username ^. suVersion), + fromIntegral (username ^. suKeyindex), + username ^. suS, + username ^. suRandom, + credential, + ttl + ) + ) + { serialConsistency = Just LocalSerialConsistency + } + ) + where + addCredential :: PrepQuery W (UserId, ClientId, Integer, Int64, Int64, Bool, Text, AsciiBase64, Int32) Row + addCredential = "INSERT INTO sft_credential (user, client, expiry, version, key_index, s, random, credential) VALUES (?, ?, ?, ?, ?, ?, ?, ?) IF NOT EXISTS USING TTL ?" + +getCredential :: + MonadClient m => + UserId -> + ClientId -> + m (Maybe (SFTUsername, AsciiBase64)) +getCredential u c = mergeColumns <$$> retry x1 (query1 q (params LocalQuorum (u, c))) + where + q :: PrepQuery R (UserId, ClientId) (Integer, Int64, Int64, Bool, Text, AsciiBase64) + q = "SELECT expiry, version, key_index, s, random, credential FROM sft_credential WHERE user = ? AND client = ? LIMIT 1" + mergeColumns (expiry, version, index, s, rand, credential) = + ( SFTUsername + (fromInteger expiry) + (fromIntegral version) + (fromIntegral index) + s + rand, + credential + ) diff --git a/services/brig/src/Brig/Options.hs b/services/brig/src/Brig/Options.hs index 12ea111f3f7..cae190a8d3c 100644 --- a/services/brig/src/Brig/Options.hs +++ b/services/brig/src/Brig/Options.hs @@ -822,7 +822,8 @@ instance FromJSON SFTOptions where data SFTTokenOptions = SFTTokenOptions { sttTTL :: !Word32, - sttSecret :: !FilePath + sttSecret :: !FilePath, + sttSecondsBeforeNew :: !Int32 } deriving (Show, Generic) @@ -831,6 +832,7 @@ instance FromJSON SFTTokenOptions where SFTTokenOptions <$> (o .: "ttl") <*> (o .: "secret") + <*> (o .: "secondsBeforeNew") asciiOnly :: Text -> Y.Parser ByteString asciiOnly t = diff --git a/services/brig/src/Brig/Schema/Run.hs b/services/brig/src/Brig/Schema/Run.hs index 049a51e5f5f..445828031ff 100644 --- a/services/brig/src/Brig/Schema/Run.hs +++ b/services/brig/src/Brig/Schema/Run.hs @@ -56,6 +56,7 @@ import Brig.Schema.V78_ClientLastActive qualified as V78_ClientLastActive import Brig.Schema.V79_ConnectionRemoteIndex qualified as V79_ConnectionRemoteIndex import Brig.Schema.V80_KeyPackageCiphersuite qualified as V80_KeyPackageCiphersuite import Brig.Schema.V81_AddFederationRemoteTeams qualified as V81_AddFederationRemoteTeams +import Brig.Schema.V82_AddSFTCredentials qualified as V82_AddSFTCredentials import Cassandra.MigrateSchema (migrateSchema) import Cassandra.Schema import Control.Exception (finally) @@ -118,7 +119,8 @@ migrations = V78_ClientLastActive.migration, V79_ConnectionRemoteIndex.migration, V80_KeyPackageCiphersuite.migration, - V81_AddFederationRemoteTeams.migration + V81_AddFederationRemoteTeams.migration, + V82_AddSFTCredentials.migration -- FUTUREWORK: undo V41 (searchable flag); we stopped using it in -- https://github.com/wireapp/wire-server/pull/964 -- diff --git a/services/brig/src/Brig/Schema/V82_AddSFTCredentials.hs b/services/brig/src/Brig/Schema/V82_AddSFTCredentials.hs new file mode 100644 index 00000000000..2f9eba9dd87 --- /dev/null +++ b/services/brig/src/Brig/Schema/V82_AddSFTCredentials.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE QuasiQuotes #-} + +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2023 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.Schema.V82_AddSFTCredentials + ( migration, + ) +where + +import Cassandra.Schema +import Imports +import Text.RawString.QQ + +migration :: Migration +migration = + Migration 82 "Add table for keeping track of and rate-limiting issuing new SFT credentials" $ do + schema' + [r| + CREATE TABLE sft_credential + ( user uuid + , client text + , expiry varint + , version bigint + , key_index bigint + , s boolean + , random text + , credential ascii + , PRIMARY KEY (user, client)) + |] diff --git a/services/brig/test/unit/Test/Brig/Calling.hs b/services/brig/test/unit/Test/Brig/Calling.hs index 77826de1593..ed5e2bca62a 100644 --- a/services/brig/test/unit/Test/Brig/Calling.hs +++ b/services/brig/test/unit/Test/Brig/Calling.hs @@ -24,6 +24,7 @@ import Brig.Calling import Brig.Calling.API import Brig.Calling.Internal import Brig.Effects.SFT +import Brig.Effects.SFTStore.Cassandra import Brig.Options import Control.Concurrent.Timeout qualified as System import Control.Lens ((^.)) @@ -296,6 +297,7 @@ testSFTStaticDeprecatedEndpoint = do . ignoreLogs . interpretSFTInMemory mempty . throwErrorInIO @_ @NoTurnServers + . interpretSFTStoreToConstant $ newConfig env (Discovered turnUri) Nothing Nothing Nothing HideAllSFTServers CallsConfigDeprecated assertEqual "when SFT static URL is disabled, sft_servers should be empty." @@ -323,6 +325,7 @@ testSFTStaticV2NoStaticUrl = do . ignoreLogs . interpretSFTInMemory mempty . throwErrorInIO @_ @NoTurnServers + . interpretSFTStoreToConstant $ newConfig env (Discovered turnUri) Nothing (Just sftEnv) (Just . unsafeRange $ 2) ListAllSFTServers CallsConfigV2 assertEqual "when SFT static URL is disabled, sft_servers_all should be from SFT environment" @@ -339,6 +342,7 @@ testSFTStaticV2StaticUrlError = do . ignoreLogs . interpretSFTInMemory mempty -- an empty lookup map, meaning there was an error . throwErrorInIO @_ @NoTurnServers + . interpretSFTStoreToConstant $ newConfig env (Discovered turnUri) (Just staticUrl) Nothing (Just . unsafeRange $ 2) ListAllSFTServers CallsConfigV2 assertEqual "when SFT static URL is enabled (and setSftListAllServers is enabled), but returns error, sft_servers_all should be omitted" @@ -358,6 +362,7 @@ testSFTStaticV2StaticUrlList = do . ignoreLogs . interpretSFTInMemory (Map.singleton staticUrl (SFTGetResponse $ Right servers)) . throwErrorInIO @_ @NoTurnServers + . interpretSFTStoreToConstant $ newConfig env (Discovered turnUri) (Just staticUrl) Nothing (Just . unsafeRange $ 3) ListAllSFTServers CallsConfigV2 assertEqual "when SFT static URL and setSftListAllServers are enabled, sft_servers_all should be from /sft_servers_all.json" @@ -376,6 +381,7 @@ testSFTStaticV2ListAllServersDisabled = do . ignoreLogs . interpretSFTInMemory (Map.singleton staticUrl (SFTGetResponse . Right $ servers)) . throwErrorInIO @_ @NoTurnServers + . interpretSFTStoreToConstant $ newConfig env (Discovered turnUri) (Just staticUrl) Nothing (Just . unsafeRange $ 3) HideAllSFTServers CallsConfigV2 assertEqual "when SFT static URL is enabled and setSftListAllServers is \"disabled\" then sft_servers_all is missing" diff --git a/services/galley/src/Galley/Cassandra/Conversation/MLS.hs b/services/galley/src/Galley/Cassandra/Conversation/MLS.hs index fbc2991247d..56eae0325f1 100644 --- a/services/galley/src/Galley/Cassandra/Conversation/MLS.hs +++ b/services/galley/src/Galley/Cassandra/Conversation/MLS.hs @@ -26,6 +26,7 @@ where import Cassandra import Cassandra.Settings import Control.Arrow +import Control.Error import Data.Time import Galley.API.MLS.Types import Galley.Cassandra.Queries qualified as Cql @@ -63,7 +64,7 @@ releaseCommitLock groupId epoch = checkTransSuccess :: [Row] -> Bool checkTransSuccess [] = False -checkTransSuccess (row : _) = either (const False) (fromMaybe False) $ fromRow 0 row +checkTransSuccess (row : _) = fromMaybe False . hush $ fromRow 0 row lookupMLSClientLeafIndices :: GroupId -> Client (ClientMap, IndexMap) lookupMLSClientLeafIndices groupId = do From 9969b96d775805c34014962464cc275730626ab4 Mon Sep 17 00:00:00 2001 From: Stefan Berthold Date: Fri, 22 Mar 2024 14:17:40 +0000 Subject: [PATCH 04/12] is_federating reflect whether brig is federating --- charts/brig/templates/configmap.yaml | 1 + charts/brig/templates/tests/configmap.yaml | 2 ++ libs/wire-api/src/Wire/API/Call/Config.hs | 7 ++++- .../golden/Test/Wire/API/Golden/Generated.hs | 3 +- .../Golden/Generated/RTCConfiguration_user.hs | 30 +++++++++++++++++++ .../testObject_RTCConfiguration_user_8.json | 16 ++++++++++ services/brig/brig.integration.yaml | 2 ++ services/brig/src/Brig/App.hs | 7 +++-- services/brig/src/Brig/Calling/API.hs | 11 +++++-- services/brig/src/Brig/Options.hs | 2 ++ 10 files changed, 74 insertions(+), 7 deletions(-) create mode 100644 libs/wire-api/test/golden/testObject_RTCConfiguration_user_8.json diff --git a/charts/brig/templates/configmap.yaml b/charts/brig/templates/configmap.yaml index 7065407f57c..d3157fd94be 100644 --- a/charts/brig/templates/configmap.yaml +++ b/charts/brig/templates/configmap.yaml @@ -57,6 +57,7 @@ data: host: gundeck port: 8080 + enableFederation: {{ .enableFederation }} {{- if .enableFederation }} # TODO remove this federator: diff --git a/charts/brig/templates/tests/configmap.yaml b/charts/brig/templates/tests/configmap.yaml index 56667e55ed3..64fac2a6df9 100644 --- a/charts/brig/templates/tests/configmap.yaml +++ b/charts/brig/templates/tests/configmap.yaml @@ -33,6 +33,8 @@ data: host: spar port: 8080 + enableFederation: true + # TODO remove this federator: host: federator diff --git a/libs/wire-api/src/Wire/API/Call/Config.hs b/libs/wire-api/src/Wire/API/Call/Config.hs index 014448fc514..a327592837b 100644 --- a/libs/wire-api/src/Wire/API/Call/Config.hs +++ b/libs/wire-api/src/Wire/API/Call/Config.hs @@ -27,6 +27,7 @@ module Wire.API.Call.Config rtcConfSftServers, rtcConfSftServersAll, rtcConfTTL, + rtcConfIsFederating, -- * RTCIceServer RTCIceServer, @@ -123,7 +124,8 @@ data RTCConfiguration = RTCConfiguration { _rtcConfIceServers :: NonEmpty RTCIceServer, _rtcConfSftServers :: Maybe (NonEmpty SFTServer), _rtcConfTTL :: Word32, - _rtcConfSftServersAll :: Maybe [AuthSFTServer] + _rtcConfSftServersAll :: Maybe [AuthSFTServer], + _rtcConfIsFederating :: Maybe Bool } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform RTCConfiguration) @@ -134,6 +136,7 @@ rtcConfiguration :: Maybe (NonEmpty SFTServer) -> Word32 -> Maybe [AuthSFTServer] -> + Maybe Bool -> RTCConfiguration rtcConfiguration = RTCConfiguration @@ -149,6 +152,8 @@ instance ToSchema RTCConfiguration where .= fieldWithDocModifier "ttl" (description ?~ "Number of seconds after which the configuration should be refreshed (advisory)") schema <*> _rtcConfSftServersAll .= maybe_ (optFieldWithDocModifier "sft_servers_all" (description ?~ "Array of all SFT servers") (array schema)) + <*> _rtcConfIsFederating + .= maybe_ (optFieldWithDocModifier "is_federating" (description ?~ "True if the client should connect to an SFT in the sft_servers_all and request it to federate") schema) -------------------------------------------------------------------------------- -- SFTServer diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated.hs index 88433fe1f78..c530bf3234b 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated.hs @@ -350,7 +350,8 @@ tests = (Test.Wire.API.Golden.Generated.RTCConfiguration_user.testObject_RTCConfiguration_user_4, "testObject_RTCConfiguration_user_4.json"), (Test.Wire.API.Golden.Generated.RTCConfiguration_user.testObject_RTCConfiguration_user_5, "testObject_RTCConfiguration_user_5.json"), (Test.Wire.API.Golden.Generated.RTCConfiguration_user.testObject_RTCConfiguration_user_6, "testObject_RTCConfiguration_user_6.json"), - (Test.Wire.API.Golden.Generated.RTCConfiguration_user.testObject_RTCConfiguration_user_7, "testObject_RTCConfiguration_user_7.json") + (Test.Wire.API.Golden.Generated.RTCConfiguration_user.testObject_RTCConfiguration_user_7, "testObject_RTCConfiguration_user_7.json"), + (Test.Wire.API.Golden.Generated.RTCConfiguration_user.testObject_RTCConfiguration_user_8, "testObject_RTCConfiguration_user_8.json") ], testGroup "Golden: SFTServer_user" $ testObjects diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/RTCConfiguration_user.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/RTCConfiguration_user.hs index a02351591e6..29c9555f4ba 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/RTCConfiguration_user.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/RTCConfiguration_user.hs @@ -123,6 +123,7 @@ testObject_RTCConfiguration_user_1 = Nothing 2 Nothing + Nothing testObject_RTCConfiguration_user_2 :: RTCConfiguration testObject_RTCConfiguration_user_2 = @@ -301,6 +302,7 @@ testObject_RTCConfiguration_user_2 = ) 4 Nothing + Nothing testObject_RTCConfiguration_user_3 :: RTCConfiguration testObject_RTCConfiguration_user_3 = @@ -446,6 +448,7 @@ testObject_RTCConfiguration_user_3 = ) 9 Nothing + Nothing testObject_RTCConfiguration_user_4 :: RTCConfiguration testObject_RTCConfiguration_user_4 = @@ -641,6 +644,7 @@ testObject_RTCConfiguration_user_4 = ) 2 Nothing + Nothing testObject_RTCConfiguration_user_5 :: RTCConfiguration testObject_RTCConfiguration_user_5 = @@ -683,6 +687,7 @@ testObject_RTCConfiguration_user_5 = ) 2 Nothing + Nothing testObject_RTCConfiguration_user_6 :: RTCConfiguration testObject_RTCConfiguration_user_6 = @@ -705,6 +710,7 @@ testObject_RTCConfiguration_user_6 = Nothing 2 Nothing + Nothing testObject_RTCConfiguration_user_7 :: RTCConfiguration testObject_RTCConfiguration_user_7 = @@ -750,3 +756,27 @@ testObject_RTCConfiguration_user_7 = "credential" ] ) + Nothing + +testObject_RTCConfiguration_user_8 :: RTCConfiguration +testObject_RTCConfiguration_user_8 = + rtcConfiguration + ( rtcIceServer + ( turnURI SchemeTurns (TurnHostIp (IpAddr (read "248.187.155.126"))) (read "1") Nothing + :| [ turnURI SchemeTurn (TurnHostIp (IpAddr (read "166.155.90.230"))) (read "0") (Just TransportTCP), + turnURI SchemeTurns (TurnHostName "xn--mgbh0fb.xn--kgbechtv") (read "1") (Just TransportTCP), + turnURI SchemeTurn (TurnHostName "host.name") (read "1") (Just TransportTCP) + ] + ) + ( turnUsername (secondsToNominalDiffTime 2.000000000000) "tj" + & tuVersion .~ 0 + & tuKeyindex .~ 0 + & tuT .~ '\1011805' + ) + (fromRight undefined (validate "")) + :| [] + ) + Nothing + 2 + Nothing + (Just True) diff --git a/libs/wire-api/test/golden/testObject_RTCConfiguration_user_8.json b/libs/wire-api/test/golden/testObject_RTCConfiguration_user_8.json new file mode 100644 index 00000000000..f3ffe63ade9 --- /dev/null +++ b/libs/wire-api/test/golden/testObject_RTCConfiguration_user_8.json @@ -0,0 +1,16 @@ +{ + "ice_servers": [ + { + "credential": "", + "urls": [ + "turns:248.187.155.126:1", + "turn:166.155.90.230:0?transport=tcp", + "turns:xn--mgbh0fb.xn--kgbechtv:1?transport=tcp", + "turn:host.name:1?transport=tcp" + ], + "username": "d=2.v=0.k=0.t=󷁝.r=tj" + } + ], + "is_federating": true, + "ttl": 2 +} diff --git a/services/brig/brig.integration.yaml b/services/brig/brig.integration.yaml index a536c77626d..b1f72cd979e 100644 --- a/services/brig/brig.integration.yaml +++ b/services/brig/brig.integration.yaml @@ -36,6 +36,8 @@ federatorInternal: host: 127.0.0.1 port: 8097 +enableFederation: true + # You can set up local SQS/Dynamo running e.g. `../../deploy/dockerephemeral/run.sh` aws: userJournalQueue: integration-user-events.fifo diff --git a/services/brig/src/Brig/App.hs b/services/brig/src/Brig/App.hs index b2373c14efa..eafec4ad09f 100644 --- a/services/brig/src/Brig/App.hs +++ b/services/brig/src/Brig/App.hs @@ -66,6 +66,7 @@ module Brig.App rabbitmqChannel, fsWatcher, disabledVersions, + enableFederation, -- * App Monad AppT (..), @@ -197,7 +198,8 @@ data Env = Env _randomPrekeyLocalLock :: Maybe (MVar ()), _keyPackageLocalLock :: MVar (), _rabbitmqChannel :: Maybe (MVar Q.Channel), - _disabledVersions :: Set Version + _disabledVersions :: Set Version, + _enableFederation :: Bool } makeLenses ''Env @@ -300,7 +302,8 @@ newEnv o = do _randomPrekeyLocalLock = prekeyLocalLock, _keyPackageLocalLock = kpLock, _rabbitmqChannel = rabbitChan, - _disabledVersions = allDisabledVersions + _disabledVersions = allDisabledVersions, + _enableFederation = Opt.enableFederation o } where emailConn _ (Opt.EmailAWS aws) = pure (Just aws, Nothing) diff --git a/services/brig/src/Brig/Calling/API.hs b/services/brig/src/Brig/Calling/API.hs index ac09c99273b..45386a71442 100644 --- a/services/brig/src/Brig/Calling/API.hs +++ b/services/brig/src/Brig/Calling/API.hs @@ -157,7 +157,7 @@ getCallsConfig _ _ = do data CallsConfigVersion = CallsConfigDeprecated | CallsConfigV2 - | AuthenticatedCallsConfig UserId ClientId + | AuthenticatedCallsConfig UserId ClientId Bool data NoTurnServers = NoTurnServers deriving (Show) @@ -207,6 +207,11 @@ newConfig env discoveredServers sftStaticUrl mSftEnv limit listAllServers versio let subsetLength = Calling.sftListLength actualSftEnv mapM (getRandomElements subsetLength) allSrvEntries + let enableFederation' = case version of + CallsConfigDeprecated -> Nothing + CallsConfigV2 -> Nothing + AuthenticatedCallsConfig _ _ fed -> Just fed + mSftServersAll <- case version of CallsConfigDeprecated -> pure Nothing @@ -215,14 +220,14 @@ newConfig env discoveredServers sftStaticUrl mSftEnv limit listAllServers versio (HideAllSFTServers, _) -> pure Nothing (ListAllSFTServers, Nothing) -> pure . pure $ Public.nauthSFTServer . sftServerFromSrvTarget . srvTarget <$> maybe [] toList allSrvEntries (ListAllSFTServers, Just url) -> Public.nauthSFTServer <$$$> (hush . unSFTGetResponse <$> sftGetAllServers url) - AuthenticatedCallsConfig u c -> + AuthenticatedCallsConfig u c _ -> case (listAllServers, sftStaticUrl) of (HideAllSFTServers, _) -> pure Nothing (ListAllSFTServers, Nothing) -> mapM (mapM $ authenticate u c) . pure $ sftServerFromSrvTarget . srvTarget <$> maybe [] toList allSrvEntries (ListAllSFTServers, Just url) -> mapM (mapM $ authenticate u c) . hush . unSFTGetResponse =<< sftGetAllServers url let mSftServers = staticSft <|> sftServerFromSrvTarget . srvTarget <$$> srvEntries - pure $ Public.rtcConfiguration srvs mSftServers (env ^. turnConfigTTL) mSftServersAll + pure $ Public.rtcConfiguration srvs mSftServers (env ^. turnConfigTTL) mSftServersAll enableFederation' where limitedList :: NonEmpty Public.TurnURI -> Range 1 10 Int -> NonEmpty Public.TurnURI limitedList uris lim = diff --git a/services/brig/src/Brig/Options.hs b/services/brig/src/Brig/Options.hs index cae190a8d3c..9b446a1a941 100644 --- a/services/brig/src/Brig/Options.hs +++ b/services/brig/src/Brig/Options.hs @@ -396,6 +396,8 @@ data Opts = Opts cassandra :: !CassandraOpts, -- | ElasticSearch settings elasticsearch :: !ElasticSearchOpts, + -- | Federation + enableFederation :: !Bool, -- | RabbitMQ settings, required when federation is enabled. rabbitmq :: !(Maybe RabbitMqOpts), -- | AWS settings From 15ad78159a8e284696c7c3ab3d3d06b2de2b7b6f Mon Sep 17 00:00:00 2001 From: Stefan Berthold Date: Mon, 25 Mar 2024 09:39:48 +0000 Subject: [PATCH 05/12] add integration tests --- services/brig/test/integration/API/Calling.hs | 100 ++++++++++++++++-- 1 file changed, 90 insertions(+), 10 deletions(-) diff --git a/services/brig/test/integration/API/Calling.hs b/services/brig/test/integration/API/Calling.hs index b6a355b1264..9242b103065 100644 --- a/services/brig/test/integration/API/Calling.hs +++ b/services/brig/test/integration/API/Calling.hs @@ -60,7 +60,9 @@ tests m b opts turn turnV2 = do "sft" [ test m "SFT servers /calls/config/v2 - 200" $ testSFT b opts, test m "SFT servers /calls/config/v2 - 200 - SFT does not respond as expected" $ testSFTUnavailable b opts "https://example.com", - test m "SFT servers /calls/config/v2 - 200 - SFT DNS does not resolve" $ testSFTUnavailable b opts "https://sft.example.com" + test m "SFT servers /calls/config/v2 - 200 - SFT DNS does not resolve" $ testSFTUnavailable b opts "https://sft.example.com", + test m "SFT crendentials with SFT secret /calls/config/authenticated - 200" $ testSFTCredentials b opts, + test m "No SFT crendentials without SFT secret /calls/config/authenticated - 200" $ testSFTNoCredentials b opts ] ] @@ -112,6 +114,80 @@ testSFT b opts = do (Set.fromList [sftServer server1, sftServer server2]) (Set.fromList $ maybe [] NonEmpty.toList $ cfg1 ^. rtcConfSftServers) +-- | This test relies on pre-created public DNS records. Code here: +-- https://github.com/zinfra/cailleach/blob/fb4caacaca02e6e28d68dc0cdebbbc987f5e31da/targets/misc/wire-server-integration-tests/dns.tf +testSFTCredentials :: Brig -> Opts.Opts -> Http () +testSFTCredentials b opts = do + uid <- userId <$> randomUser b + cid <- randomClient + let ttl = 60 + secondsToNew = 30 + withSettingsOverrides + ( opts + & Opts.sftL + ?~ Opts.SFTOptions + "integration-tests.zinfra.io" + Nothing + (Just 0.001) + Nothing + (Just $ Opts.SFTTokenOptions ttl "test/resources/turn/secret.txt" secondsToNew) + & Opts.optionSettings . Opts.sftListAllServers ?~ Opts.ListAllSFTServers + ) + $ do + allSFTServers <- fromMaybe [] . (^. rtcConfSftServersAll) <$> retryWhileN 10 (isNothing . view rtcConfSftServers) (getTurnConfigurationAuthenticated uid cid b) + -- These values are controlled by https://github.com/zinfra/cailleach/tree/77ca2d23cf2959aa183dd945d0a0b13537a8950d/environments/dns-integration-tests + let Right server1 = mkHttpsUrl =<< first show (parseURI laxURIParserOptions "https://sft01.integration-tests.zinfra.io:443") + let Right server2 = mkHttpsUrl =<< first show (parseURI laxURIParserOptions "https://sft02.integration-tests.zinfra.io:8443") + liftIO $ + assertEqual + "when list_all_sft_servers is enabled, sft_servers_all should be returned" + (Set.fromList [server1, server2]) + (Set.fromList $ map (^. authURL) allSFTServers) + liftIO $ + assertBool + "when SFT secret is defined, a username should be returned for each SFT server" + (all (isJust . (^. authUsername)) allSFTServers) + liftIO $ + assertBool + "when SFT secret is defined, a credential should be returned for each SFT server" + (all (isJust . (^. authCredential)) allSFTServers) + +-- | This test relies on pre-created public DNS records. Code here: +-- https://github.com/zinfra/cailleach/blob/fb4caacaca02e6e28d68dc0cdebbbc987f5e31da/targets/misc/wire-server-integration-tests/dns.tf +testSFTNoCredentials :: Brig -> Opts.Opts -> Http () +testSFTNoCredentials b opts = do + uid <- userId <$> randomUser b + cid <- randomClient + withSettingsOverrides + ( opts + & Opts.sftL + ?~ Opts.SFTOptions + "integration-tests.zinfra.io" + Nothing + (Just 0.001) + Nothing + Nothing + & Opts.optionSettings . Opts.sftListAllServers ?~ Opts.ListAllSFTServers + ) + $ do + allSFTServers <- fromMaybe [] . (^. rtcConfSftServersAll) <$> retryWhileN 10 (isNothing . view rtcConfSftServers) (getTurnConfigurationAuthenticated uid cid b) + -- These values are controlled by https://github.com/zinfra/cailleach/tree/77ca2d23cf2959aa183dd945d0a0b13537a8950d/environments/dns-integration-tests + let Right server1 = mkHttpsUrl =<< first show (parseURI laxURIParserOptions "https://sft01.integration-tests.zinfra.io:443") + let Right server2 = mkHttpsUrl =<< first show (parseURI laxURIParserOptions "https://sft02.integration-tests.zinfra.io:8443") + liftIO $ + assertEqual + "when list_all_sft_servers is enabled, sft_servers_all should be returned" + (Set.fromList [server1, server2]) + (Set.fromList $ map (^. authURL) allSFTServers) + liftIO $ + assertBool + "when SFT secret is defined, a username should be returned for each SFT server" + (all (isNothing . (^. authUsername)) allSFTServers) + liftIO $ + assertBool + "when SFT secret is defined, a credential should be returned for each SFT server" + (all (isNothing . (^. authCredential)) allSFTServers) + testSFTUnavailable :: Brig -> Opts.Opts -> String -> Http () testSFTUnavailable b opts domain = do uid <- userId <$> randomUser b @@ -179,7 +255,7 @@ testCallsConfigSRV b opts = do config <- withSettingsOverrides (opts & Opts.turnL . Opts.serversSourceL .~ dnsOpts) $ responseJsonError - =<< ( retryWhileN 10 (\r -> statusCode r /= 200) (getTurnConfiguration "" uid b) + =<< ( retryWhileN 10 (\r -> statusCode r /= 200) (getTurnConfiguration "" uid Nothing b) statusCode r /= 200) (getTurnConfiguration "v2" uid b) + =<< ( retryWhileN 10 (\r -> statusCode r /= 200) (getTurnConfiguration "v2" uid Nothing b) Brig -> Http RTCConfiguration -getTurnConfigurationV1 = getAndValidateTurnConfiguration "" +getTurnConfigurationV1 = flip (getAndValidateTurnConfiguration "") Nothing getTurnConfigurationV2 :: HasCallStack => UserId -> Brig -> ((MonadHttp m, MonadIO m, MonadCatch m) => m RTCConfiguration) -getTurnConfigurationV2 = getAndValidateTurnConfiguration "v2" +getTurnConfigurationV2 = flip (getAndValidateTurnConfiguration "v2") Nothing + +getTurnConfigurationAuthenticated :: HasCallStack => UserId -> ClientId -> Brig -> ((MonadHttp m, MonadIO m, MonadCatch m) => m RTCConfiguration) +getTurnConfigurationAuthenticated u = getAndValidateTurnConfiguration "authenticated" u . Just -getTurnConfiguration :: ByteString -> UserId -> Brig -> (MonadHttp m => m (Response (Maybe LB.ByteString))) -getTurnConfiguration suffix u b = +getTurnConfiguration :: ByteString -> UserId -> Maybe ClientId -> Brig -> (MonadHttp m => m (Response (Maybe LB.ByteString))) +getTurnConfiguration suffix u mc b = get ( b . paths ["/calls/config", suffix] . zUser u + . maybe id zClient mc . zConn "conn" ) -getAndValidateTurnConfiguration :: HasCallStack => ByteString -> UserId -> Brig -> ((MonadIO m, MonadHttp m, MonadCatch m) => m RTCConfiguration) -getAndValidateTurnConfiguration suffix u b = - responseJsonError =<< (getTurnConfiguration suffix u b ByteString -> UserId -> Maybe ClientId -> Brig -> ((MonadIO m, MonadHttp m, MonadCatch m) => m RTCConfiguration) +getAndValidateTurnConfiguration suffix u mc b = + responseJsonError =<< (getTurnConfiguration suffix u mc b UserId -> Brig -> Http (Response (Maybe LB.ByteString)) getTurnConfigurationV2Limit limit u b = From 57ac6746882258006936c1bd2dd59398cbd04df0 Mon Sep 17 00:00:00 2001 From: Stefan Berthold Date: Tue, 26 Mar 2024 16:08:16 +0000 Subject: [PATCH 06/12] use multiSFT for is_federating --- charts/brig/templates/configmap.yaml | 2 +- charts/brig/templates/tests/configmap.yaml | 2 +- charts/brig/values.yaml | 2 + charts/sftd/values.yaml | 2 +- hack/helm_vars/wire-server/values.yaml.gotmpl | 2 + services/brig/brig.integration.yaml | 2 +- services/brig/src/Brig/App.hs | 6 +-- services/brig/src/Brig/Calling/API.hs | 12 +++--- services/brig/src/Brig/Options.hs | 7 +-- services/brig/test/integration/API/Calling.hs | 43 ++++++++++++++++++- 10 files changed, 63 insertions(+), 17 deletions(-) diff --git a/charts/brig/templates/configmap.yaml b/charts/brig/templates/configmap.yaml index d3157fd94be..25741a509c4 100644 --- a/charts/brig/templates/configmap.yaml +++ b/charts/brig/templates/configmap.yaml @@ -57,7 +57,7 @@ data: host: gundeck port: 8080 - enableFederation: {{ .enableFederation }} + multiSFT: {{ .multiSFT.enabled }} {{- if .enableFederation }} # TODO remove this federator: diff --git a/charts/brig/templates/tests/configmap.yaml b/charts/brig/templates/tests/configmap.yaml index 64fac2a6df9..f4f2ce08fe9 100644 --- a/charts/brig/templates/tests/configmap.yaml +++ b/charts/brig/templates/tests/configmap.yaml @@ -33,7 +33,7 @@ data: host: spar port: 8080 - enableFederation: true + multiSFT: false # TODO remove this federator: diff --git a/charts/brig/values.yaml b/charts/brig/values.yaml index 6afcd1a853d..a500b9e9cc7 100644 --- a/charts/brig/values.yaml +++ b/charts/brig/values.yaml @@ -40,6 +40,8 @@ config: # -- If set to false, 'dynamoDBEndpoint' _must_ be set. randomPrekeys: true useSES: true + multiSFT: + enabled: false # keep multiSFT default in sync with sft chart's multiSFT.enabled enableFederation: false # keep enableFederation default in sync with galley and cargohold chart's config.enableFederation as well as wire-server chart's tags.federation # Not used if enableFederation is false rabbitmq: diff --git a/charts/sftd/values.yaml b/charts/sftd/values.yaml index c9e23fa2990..4a3b90c6a0a 100644 --- a/charts/sftd/values.yaml +++ b/charts/sftd/values.yaml @@ -96,7 +96,7 @@ turnDiscoveryEnabled: false # Allow establishing calls involving remote SFT servers (e.g. for Federation) # Requires appVersion 3.0.9 or later multiSFT: - enabled: false + enabled: false # keep multiSFT default in sync with brig chart's config.multiSFT # For sftd versions up to 3.1.3, sftd uses the TURN servers advertised at a # discovery URL. turnDiscoveryURL: "" diff --git a/hack/helm_vars/wire-server/values.yaml.gotmpl b/hack/helm_vars/wire-server/values.yaml.gotmpl index dec2183e9c5..b7ef73d8fa8 100644 --- a/hack/helm_vars/wire-server/values.yaml.gotmpl +++ b/hack/helm_vars/wire-server/values.yaml.gotmpl @@ -73,6 +73,8 @@ brig: accessTokenTimeout: 30 providerTokenTimeout: 60 enableFederation: true # keep in sync with galley.config.enableFederation, cargohold.config.enableFederation and tags.federator! + multiSFT: + enabled: false # keep multiSFT default in sync with brig and sft chart's config.multiSFT optSettings: setActivationTimeout: 10 setVerificationTimeout: 10 diff --git a/services/brig/brig.integration.yaml b/services/brig/brig.integration.yaml index b1f72cd979e..451e753ccac 100644 --- a/services/brig/brig.integration.yaml +++ b/services/brig/brig.integration.yaml @@ -36,7 +36,7 @@ federatorInternal: host: 127.0.0.1 port: 8097 -enableFederation: true +multiSFT: false # You can set up local SQS/Dynamo running e.g. `../../deploy/dockerephemeral/run.sh` aws: diff --git a/services/brig/src/Brig/App.hs b/services/brig/src/Brig/App.hs index eafec4ad09f..6b3c39a3b4b 100644 --- a/services/brig/src/Brig/App.hs +++ b/services/brig/src/Brig/App.hs @@ -66,7 +66,7 @@ module Brig.App rabbitmqChannel, fsWatcher, disabledVersions, - enableFederation, + enableSFTFederation, -- * App Monad AppT (..), @@ -199,7 +199,7 @@ data Env = Env _keyPackageLocalLock :: MVar (), _rabbitmqChannel :: Maybe (MVar Q.Channel), _disabledVersions :: Set Version, - _enableFederation :: Bool + _enableSFTFederation :: Maybe Bool } makeLenses ''Env @@ -303,7 +303,7 @@ newEnv o = do _keyPackageLocalLock = kpLock, _rabbitmqChannel = rabbitChan, _disabledVersions = allDisabledVersions, - _enableFederation = Opt.enableFederation o + _enableSFTFederation = Opt.multiSFT o } where emailConn _ (Opt.EmailAWS aws) = pure (Just aws, Nothing) diff --git a/services/brig/src/Brig/Calling/API.hs b/services/brig/src/Brig/Calling/API.hs index 45386a71442..2389c7895aa 100644 --- a/services/brig/src/Brig/Calling/API.hs +++ b/services/brig/src/Brig/Calling/API.hs @@ -77,7 +77,7 @@ getAuthenticatedCallsConfig u c _ limit = do staticUrl <- view $ settings . Opt.sftStaticUrl sftListAllServers <- fromMaybe Opt.HideAllSFTServers <$> view (settings . Opt.sftListAllServers) sftEnv' <- view sftEnv - enableFederation' <- view enableFederation + sftFederation <- view enableSFTFederation discoveredServers <- turnServersV2 (env ^. turnServers) eitherConfig <- lift @@ -90,7 +90,7 @@ getAuthenticatedCallsConfig u c _ limit = do sftEnv' limit sftListAllServers - (AuthenticatedCallsConfig u c enableFederation') + (AuthenticatedCallsConfig u c sftFederation) handleNoTurnServers eitherConfig -- | ('UserId', 'ConnId' are required as args here to make sure this is an authenticated end-point.) @@ -157,7 +157,7 @@ getCallsConfig _ _ = do data CallsConfigVersion = CallsConfigDeprecated | CallsConfigV2 - | AuthenticatedCallsConfig UserId ClientId Bool + | AuthenticatedCallsConfig UserId ClientId (Maybe Bool) data NoTurnServers = NoTurnServers deriving (Show) @@ -207,10 +207,10 @@ newConfig env discoveredServers sftStaticUrl mSftEnv limit listAllServers versio let subsetLength = Calling.sftListLength actualSftEnv mapM (getRandomElements subsetLength) allSrvEntries - let enableFederation' = case version of + let sftFederation' = case version of CallsConfigDeprecated -> Nothing CallsConfigV2 -> Nothing - AuthenticatedCallsConfig _ _ fed -> Just fed + AuthenticatedCallsConfig _ _ fed -> fed mSftServersAll <- case version of @@ -227,7 +227,7 @@ newConfig env discoveredServers sftStaticUrl mSftEnv limit listAllServers versio (ListAllSFTServers, Just url) -> mapM (mapM $ authenticate u c) . hush . unSFTGetResponse =<< sftGetAllServers url let mSftServers = staticSft <|> sftServerFromSrvTarget . srvTarget <$$> srvEntries - pure $ Public.rtcConfiguration srvs mSftServers (env ^. turnConfigTTL) mSftServersAll enableFederation' + pure $ Public.rtcConfiguration srvs mSftServers (env ^. turnConfigTTL) mSftServersAll sftFederation' where limitedList :: NonEmpty Public.TurnURI -> Range 1 10 Int -> NonEmpty Public.TurnURI limitedList uris lim = diff --git a/services/brig/src/Brig/Options.hs b/services/brig/src/Brig/Options.hs index 9b446a1a941..6bc0d584abc 100644 --- a/services/brig/src/Brig/Options.hs +++ b/services/brig/src/Brig/Options.hs @@ -396,8 +396,8 @@ data Opts = Opts cassandra :: !CassandraOpts, -- | ElasticSearch settings elasticsearch :: !ElasticSearchOpts, - -- | Federation - enableFederation :: !Bool, + -- | SFT Federation + multiSFT :: !(Maybe Bool), -- | RabbitMQ settings, required when federation is enabled. rabbitmq :: !(Maybe RabbitMqOpts), -- | AWS settings @@ -904,7 +904,8 @@ Lens.makeLensesFor [ ("optSettings", "optionSettings"), ("elasticsearch", "elasticsearchL"), ("sft", "sftL"), - ("turn", "turnL") + ("turn", "turnL"), + ("multiSFT", "multiSFTL") ] ''Opts diff --git a/services/brig/test/integration/API/Calling.hs b/services/brig/test/integration/API/Calling.hs index 9242b103065..c476c3d3454 100644 --- a/services/brig/test/integration/API/Calling.hs +++ b/services/brig/test/integration/API/Calling.hs @@ -62,7 +62,8 @@ tests m b opts turn turnV2 = do test m "SFT servers /calls/config/v2 - 200 - SFT does not respond as expected" $ testSFTUnavailable b opts "https://example.com", test m "SFT servers /calls/config/v2 - 200 - SFT DNS does not resolve" $ testSFTUnavailable b opts "https://sft.example.com", test m "SFT crendentials with SFT secret /calls/config/authenticated - 200" $ testSFTCredentials b opts, - test m "No SFT crendentials without SFT secret /calls/config/authenticated - 200" $ testSFTNoCredentials b opts + test m "No SFT crendentials without SFT secret /calls/config/authenticated - 200" $ testSFTNoCredentials b opts, + test m "SFT federation /calls/config/authenticated - 200" $ testSFTFederation b opts ] ] @@ -188,6 +189,46 @@ testSFTNoCredentials b opts = do "when SFT secret is defined, a credential should be returned for each SFT server" (all (isNothing . (^. authCredential)) allSFTServers) +-- | This test relies on pre-created public DNS records. Code here: +-- https://github.com/zinfra/cailleach/blob/fb4caacaca02e6e28d68dc0cdebbbc987f5e31da/targets/misc/wire-server-integration-tests/dns.tf +testSFTFederation :: Brig -> Opts.Opts -> Http () +testSFTFederation b opts = do + uid <- userId <$> randomUser b + cid <- randomClient + withSettingsOverrides + ( opts + & Opts.multiSFTL .~ Nothing + & Opts.sftL ?~ Opts.SFTOptions "integration-tests.zinfra.io" Nothing (Just 0.001) Nothing Nothing + ) + $ do + isFederating <- (^. rtcConfIsFederating) <$> retryWhileN 10 (isNothing . view rtcConfSftServers) (getTurnConfigurationAuthenticated uid cid b) + liftIO $ + assertBool + "SFT federation is not defined" + (isNothing isFederating) + withSettingsOverrides + ( opts + & Opts.multiSFTL ?~ True + & Opts.sftL ?~ Opts.SFTOptions "integration-tests.zinfra.io" Nothing (Just 0.001) Nothing Nothing + ) + $ do + isFederating <- (^. rtcConfIsFederating) <$> retryWhileN 10 (isNothing . view rtcConfSftServers) (getTurnConfigurationAuthenticated uid cid b) + liftIO $ + assertBool + "SFT federation is defined and true" + (fromMaybe False isFederating) + withSettingsOverrides + ( opts + & Opts.multiSFTL ?~ False + & Opts.sftL ?~ Opts.SFTOptions "integration-tests.zinfra.io" Nothing (Just 0.001) Nothing Nothing + ) + $ do + isFederating <- (^. rtcConfIsFederating) <$> retryWhileN 10 (isNothing . view rtcConfSftServers) (getTurnConfigurationAuthenticated uid cid b) + liftIO $ + assertBool + "SFT federation is defined and false" + (not $ fromMaybe False isFederating) + testSFTUnavailable :: Brig -> Opts.Opts -> String -> Http () testSFTUnavailable b opts domain = do uid <- userId <$> randomUser b From 5e53c5a1860d5c168123ed33be8272bd762fc163 Mon Sep 17 00:00:00 2001 From: Stefan Berthold Date: Wed, 27 Mar 2024 15:27:56 +0000 Subject: [PATCH 07/12] add documentation and changelogs --- changelog.d/0-release-notes/WPB-227 | 35 +++++++++++++++++++ changelog.d/1-api-changes/WPB-227 | 12 +++++++ .../src/developer/reference/config-options.md | 25 +++++++++++++ 3 files changed, 72 insertions(+) create mode 100644 changelog.d/0-release-notes/WPB-227 create mode 100644 changelog.d/1-api-changes/WPB-227 diff --git a/changelog.d/0-release-notes/WPB-227 b/changelog.d/0-release-notes/WPB-227 new file mode 100644 index 00000000000..876df5be115 --- /dev/null +++ b/changelog.d/0-release-notes/WPB-227 @@ -0,0 +1,35 @@ +There is a new optional Boolean option, `multiSFT.enabled`, in `brig.yaml`, +allowing calls between federated SFT servers. If provided, the field +`is_federating` in the response of `/calls/config/authenticated` will reflect +`multiSFT.enabled`'s value. + +Example: + +``` +# [brig.yaml] +multiSFT: + enabled: true +``` + +Also, the optional object `sftToken` with its fields `ttl`, `secret`, and +`secondsBeforeNew` define whether an SFT credential would be rendered in the +response of `/calls/config/authenticated`. The field `ttl` determines the +seconds for the credential to be valid, `secondsBeforeNew` determines the amount +of time which has to pass before a new token will be generated, preventing one +client to create too many new credentials, and `secret` is the path to the +secret shared with SFT to create credentials. + +Example: + +``` +# [brig.yaml] +sft: + sftBaseDomain: sft.wire.example.com + sftSRVServiceName: sft + sftDiscoveryIntervalSeconds: 10 + sftListLength: 20 + sftToken: + ttl: 120 + secret: /path/to/secret + secondsBeforeNew: 60 +``` diff --git a/changelog.d/1-api-changes/WPB-227 b/changelog.d/1-api-changes/WPB-227 new file mode 100644 index 00000000000..a5f99bf5841 --- /dev/null +++ b/changelog.d/1-api-changes/WPB-227 @@ -0,0 +1,12 @@ +The new endpoint `/calls/config/authenticated` returns the same data as +`/calls/config/v2` and in addition features a new optional field `is_federating` +which reflects whether SFT federation is enabled or not. Also, the new optional +fields `username` and `credential` in the `sft_servers_all` object of the +endpoint's response provide the SFT credential which the authenticated client +should use for connecting to SFT. The credential will only be generated if a +secret shared between SFT and Brig has been configured for Brig. Repeated calls +to the endpoint will not lead to newly issued SFT credentials until a configured +timespan has been elapsed. During this timespan, the already provided SFT +credential will be replayed in the endpoint's response. For this to work, +clients have to send the `Z-Client` header in their requests to this new +endpoint. diff --git a/docs/src/developer/reference/config-options.md b/docs/src/developer/reference/config-options.md index d45c805dc65..a472fe543e1 100644 --- a/docs/src/developer/reference/config-options.md +++ b/docs/src/developer/reference/config-options.md @@ -517,6 +517,31 @@ This setting assumes that the sft load balancer has been deployed with the `sftd Additionally if `setSftListAllServers` is set to `enabled` (disabled by default) then the `/calls/config/v2` endpoint will include a list of all servers that are load balanced by `setSftStaticUrl` at field `sft_servers_all`. This is required to enable calls between federated instances of Wire. +Calls between federated SFT servers can be enabled using the optional boolean `multiSFT.enabled`. If provided, the field `is_federating` in the response of `/calls/config/authenticated` will reflect `multiSFT.enabled`'s value. + +``` +# [brig.yaml] +multiSFT: + enabled: true +``` + +Also, the optional object `sftToken` with its fields `ttl`, `secret`, and `secondsBeforeNew` define whether an SFT credential would be rendered in the response of `/calls/config/authenticated`. The field `ttl` determines the seconds for the credential to be valid, `secondsBeforeNew` determines the amount of time which has to pass before a new token will be generated, preventing one client to create too many new credentials, and `secret` is the path to the secret shared with SFT to create credentials. + +Example: + +``` +# [brig.yaml] +sft: + sftBaseDomain: sft.wire.example.com + sftSRVServiceName: sft + sftDiscoveryIntervalSeconds: 10 + sftListLength: 20 + sftToken: + ttl: 120 + secret: /path/to/secret + secondsBeforeNew: 60 +``` + ### Locale From cc2937d77e2eeb165100243335ad6c97e4678d91 Mon Sep 17 00:00:00 2001 From: Stefan Berthold Date: Thu, 28 Mar 2024 13:54:39 +0000 Subject: [PATCH 08/12] fix configmap and typo --- charts/brig/templates/configmap.yaml | 8 ++++++++ services/brig/test/integration/API/Calling.hs | 4 ++-- 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/charts/brig/templates/configmap.yaml b/charts/brig/templates/configmap.yaml index 25741a509c4..e260584699e 100644 --- a/charts/brig/templates/configmap.yaml +++ b/charts/brig/templates/configmap.yaml @@ -210,6 +210,14 @@ data: {{- if .sftDiscoveryIntervalSeconds }} sftDiscoveryIntervalSeconds: {{ .sftDiscoveryIntervalSeconds }} {{- end }} + {{- if .sftToken }} + sftToken: + {{- with .sftToken }} + ttl: {{ .ttl }} + secret: {{ .secret }} + secondsBeforeNew: {{ .secondsBeforeNew }} + {{- end }} + {{- end }} {{- end }} {{- end }} diff --git a/services/brig/test/integration/API/Calling.hs b/services/brig/test/integration/API/Calling.hs index c476c3d3454..50d49c0c8d9 100644 --- a/services/brig/test/integration/API/Calling.hs +++ b/services/brig/test/integration/API/Calling.hs @@ -61,8 +61,8 @@ tests m b opts turn turnV2 = do [ test m "SFT servers /calls/config/v2 - 200" $ testSFT b opts, test m "SFT servers /calls/config/v2 - 200 - SFT does not respond as expected" $ testSFTUnavailable b opts "https://example.com", test m "SFT servers /calls/config/v2 - 200 - SFT DNS does not resolve" $ testSFTUnavailable b opts "https://sft.example.com", - test m "SFT crendentials with SFT secret /calls/config/authenticated - 200" $ testSFTCredentials b opts, - test m "No SFT crendentials without SFT secret /calls/config/authenticated - 200" $ testSFTNoCredentials b opts, + test m "SFT credentials with SFT secret /calls/config/authenticated - 200" $ testSFTCredentials b opts, + test m "No SFT credentials without SFT secret /calls/config/authenticated - 200" $ testSFTNoCredentials b opts, test m "SFT federation /calls/config/authenticated - 200" $ testSFTFederation b opts ] ] From eaeec6c1e5c60781eb0f47c024dcfa259e01152b Mon Sep 17 00:00:00 2001 From: Stefan Berthold Date: Thu, 28 Mar 2024 15:09:27 +0000 Subject: [PATCH 09/12] fix testSFTCredentials in CI --- services/brig/test/integration/API/Calling.hs | 62 ++++++++++--------- 1 file changed, 33 insertions(+), 29 deletions(-) diff --git a/services/brig/test/integration/API/Calling.hs b/services/brig/test/integration/API/Calling.hs index 50d49c0c8d9..ec163beb58e 100644 --- a/services/brig/test/integration/API/Calling.hs +++ b/services/brig/test/integration/API/Calling.hs @@ -35,6 +35,7 @@ import Data.Misc (Port (..), mkHttpsUrl) import Data.Set qualified as Set import Imports import System.FilePath (()) +import System.IO (hPutStr) import Test.Tasty import Test.Tasty.HUnit import URI.ByteString (laxURIParserOptions, parseURI) @@ -123,35 +124,38 @@ testSFTCredentials b opts = do cid <- randomClient let ttl = 60 secondsToNew = 30 - withSettingsOverrides - ( opts - & Opts.sftL - ?~ Opts.SFTOptions - "integration-tests.zinfra.io" - Nothing - (Just 0.001) - Nothing - (Just $ Opts.SFTTokenOptions ttl "test/resources/turn/secret.txt" secondsToNew) - & Opts.optionSettings . Opts.sftListAllServers ?~ Opts.ListAllSFTServers - ) - $ do - allSFTServers <- fromMaybe [] . (^. rtcConfSftServersAll) <$> retryWhileN 10 (isNothing . view rtcConfSftServers) (getTurnConfigurationAuthenticated uid cid b) - -- These values are controlled by https://github.com/zinfra/cailleach/tree/77ca2d23cf2959aa183dd945d0a0b13537a8950d/environments/dns-integration-tests - let Right server1 = mkHttpsUrl =<< first show (parseURI laxURIParserOptions "https://sft01.integration-tests.zinfra.io:443") - let Right server2 = mkHttpsUrl =<< first show (parseURI laxURIParserOptions "https://sft02.integration-tests.zinfra.io:8443") - liftIO $ - assertEqual - "when list_all_sft_servers is enabled, sft_servers_all should be returned" - (Set.fromList [server1, server2]) - (Set.fromList $ map (^. authURL) allSFTServers) - liftIO $ - assertBool - "when SFT secret is defined, a username should be returned for each SFT server" - (all (isJust . (^. authUsername)) allSFTServers) - liftIO $ - assertBool - "when SFT secret is defined, a credential should be returned for each SFT server" - (all (isJust . (^. authCredential)) allSFTServers) + liftIO $ Temp.withSystemTempFile "sft-secret" $ \secretFile secretHandle -> do + hPutStr secretHandle "xMtZyTpu=Leb?YKCoq#BXQR:gG^UrE83dNWzFJ2VcD" + hClose secretHandle + withSettingsOverrides + ( opts + & Opts.sftL + ?~ Opts.SFTOptions + "integration-tests.zinfra.io" + Nothing + (Just 0.001) + Nothing + (Just $ Opts.SFTTokenOptions ttl secretFile secondsToNew) + & Opts.optionSettings . Opts.sftListAllServers ?~ Opts.ListAllSFTServers + ) + $ do + allSFTServers <- fromMaybe [] . (^. rtcConfSftServersAll) <$> retryWhileN 10 (isNothing . view rtcConfSftServers) (getTurnConfigurationAuthenticated uid cid b) + -- These values are controlled by https://github.com/zinfra/cailleach/tree/77ca2d23cf2959aa183dd945d0a0b13537a8950d/environments/dns-integration-tests + let Right server1 = mkHttpsUrl =<< first show (parseURI laxURIParserOptions "https://sft01.integration-tests.zinfra.io:443") + let Right server2 = mkHttpsUrl =<< first show (parseURI laxURIParserOptions "https://sft02.integration-tests.zinfra.io:8443") + liftIO $ + assertEqual + "when list_all_sft_servers is enabled, sft_servers_all should be returned" + (Set.fromList [server1, server2]) + (Set.fromList $ map (^. authURL) allSFTServers) + liftIO $ + assertBool + "when SFT secret is defined, a username should be returned for each SFT server" + (all (isJust . (^. authUsername)) allSFTServers) + liftIO $ + assertBool + "when SFT secret is defined, a credential should be returned for each SFT server" + (all (isJust . (^. authCredential)) allSFTServers) -- | This test relies on pre-created public DNS records. Code here: -- https://github.com/zinfra/cailleach/blob/fb4caacaca02e6e28d68dc0cdebbbc987f5e31da/targets/misc/wire-server-integration-tests/dns.tf From df7e86e1191cd711c9ff351f2663bb80fa4782a2 Mon Sep 17 00:00:00 2001 From: Stefan Berthold Date: Wed, 3 Apr 2024 08:31:19 +0000 Subject: [PATCH 10/12] moving integration tests to /integration --- integration/test/API/Brig.hs | 7 + integration/test/Test/Brig.hs | 114 +++++++++++++- integration/test/Testlib/JSON.hs | 12 +- services/brig/test/integration/API/Calling.hs | 145 ++---------------- 4 files changed, 137 insertions(+), 141 deletions(-) diff --git a/integration/test/API/Brig.hs b/integration/test/API/Brig.hs index 908a0db996d..8f310f0c731 100644 --- a/integration/test/API/Brig.hs +++ b/integration/test/API/Brig.hs @@ -636,3 +636,10 @@ renewToken :: (HasCallStack, MakesValue uid) => uid -> String -> App Response renewToken caller cookie = do req <- baseRequest caller Brig Versioned "access" submit "POST" (addHeader "Cookie" ("zuid=" <> cookie) req) + +-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/get_calls_config_v2 +getCallsConfigAuthenticated :: (HasCallStack, MakesValue user, MakesValue client) => user -> client -> App Response +getCallsConfigAuthenticated user client = do + cli <- client & objId + req <- baseRequest user Brig Versioned $ joinHttpPath ["calls", "config", "authenticated"] + submit "GET" $ zClient cli req diff --git a/integration/test/Test/Brig.hs b/integration/test/Test/Brig.hs index 17753fd3ea9..408fea5e540 100644 --- a/integration/test/Test/Brig.hs +++ b/integration/test/Test/Brig.hs @@ -1,15 +1,19 @@ module Test.Brig where +import API.Brig (getCallsConfigAuthenticated) import qualified API.BrigInternal as BrigI -import API.Common (randomName) +import API.Common import Data.Aeson.Types hiding ((.=)) +import Data.List.Split import Data.String.Conversions import qualified Data.UUID as UUID import qualified Data.UUID.V4 as UUID import GHC.Stack import SetupHelpers +import System.IO.Extra import Testlib.Assertions import Testlib.Prelude +import UnliftIO.Temporary testCrudFederationRemotes :: HasCallStack => App () testCrudFederationRemotes = do @@ -124,3 +128,111 @@ testCrudFederationRemoteTeams = do l <- resp.json & asList remoteTeams <- forM l (\e -> e %. "team_id" & asString) when (any (\t -> t `notElem` remoteTeams) tids) $ assertFailure "Expected response to contain all of the teams" + +testSFTCredentials :: HasCallStack => App () +testSFTCredentials = do + let ttl = (60 :: Int) + secondsToNew = (30 :: Int) + withSystemTempFile "sft-secret" $ \secretFile secretHandle -> do + liftIO $ do + hPutStr secretHandle "xMtZyTpu=Leb?YKCoq#BXQR:gG^UrE83dNWzFJ2VcD" + hClose secretHandle + withModifiedBackend + ( def + { brigCfg = + ( setField "sft.sftBaseDomain" "integration-tests.zinfra.io" + . setField "sft.sftToken.ttl" ttl + . setField "sft.sftToken.secret" secretFile + . setField "sft.sftToken.secondsBeforeNew" secondsToNew + . setField "optSettings.setSftListAllServers" "enabled" + ) + } + ) + $ \domain -> do + user <- randomUser domain def + client <- randomClientId + bindResponse (getCallsConfigAuthenticated user client) \resp -> do + sftServersAll <- resp.json %. "sft_servers_all" & asList + when (null sftServersAll) $ assertFailure "sft_servers_all missing" + for_ sftServersAll $ \s -> do + cred <- s %. "credential" & asString + when (null cred) $ assertFailure "credential missing" + usr <- s %. "username" & asString + let parts = splitOn "." 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 $ \part -> when (length part < 3) $ assertFailure ("value missing for " <> part) + +testSFTNoCredentials :: HasCallStack => App () +testSFTNoCredentials = withModifiedBackend + ( def + { brigCfg = + ( setField "sft.sftBaseDomain" "integration-tests.zinfra.io" + . setField "optSettings.setSftListAllServers" "enabled" + ) + } + ) + $ \domain -> do + user <- randomUser domain def + client <- randomClientId + bindResponse (getCallsConfigAuthenticated user client) \resp -> do + sftServersAll <- resp.json %. "sft_servers_all" & asList + when (null sftServersAll) $ assertFailure "sft_servers_all missing" + for_ sftServersAll $ \s -> do + credM <- lookupField s "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 = do + withModifiedBackend + ( def + { brigCfg = + ( setField "sft.sftBaseDomain" "integration-tests.zinfra.io" + . removeField "multiSFT" + ) + } + ) + $ \domain -> do + user <- randomUser domain def + client <- randomClientId + bindResponse (getCallsConfigAuthenticated user client) \resp -> do + isFederatingM <- lookupField resp.json "is_federating" + when (isJust isFederatingM) $ assertFailure "is_federating should not be present" + withModifiedBackend + ( def + { brigCfg = + ( setField "sft.sftBaseDomain" "integration-tests.zinfra.io" + . setField "multiSFT" True + ) + } + ) + $ \domain -> do + user <- randomUser domain def + client <- randomClientId + bindResponse (getCallsConfigAuthenticated user client) \resp -> do + isFederating <- + maybe (assertFailure "is_federating missing") asBool + =<< lookupField resp.json "is_federating" + unless isFederating $ assertFailure "is_federating should be true" + withModifiedBackend + ( def + { brigCfg = + ( setField "sft.sftBaseDomain" "integration-tests.zinfra.io" + . setField "multiSFT" False + ) + } + ) + $ \domain -> do + user <- randomUser domain def + client <- randomClientId + bindResponse (getCallsConfigAuthenticated user client) \resp -> do + isFederating <- + maybe (assertFailure "is_federating missing") asBool + =<< lookupField resp.json "is_federating" + when isFederating $ assertFailure "is_federating should be false" diff --git a/integration/test/Testlib/JSON.hs b/integration/test/Testlib/JSON.hs index ee21cf2f7f7..fb0a99462ae 100644 --- a/integration/test/Testlib/JSON.hs +++ b/integration/test/Testlib/JSON.hs @@ -236,8 +236,9 @@ lookupField val selector = do go k [] v = get v k go k (k2 : ks) v = get v k >>= assertField v k >>= go k2 ks --- Update nested fields +-- | Update nested fields -- E.g. ob & "foo.bar.baz" %.= ("quux" :: String) +-- The selector path will be created if non-existing. setField :: forall a b. (HasCallStack, MakesValue a, ToJSON b) => @@ -253,7 +254,8 @@ setField selector v x = do member :: (HasCallStack, MakesValue a) => String -> a -> App Bool member k x = KM.member (KM.fromString k) <$> (make x >>= asObject) --- Update nested fields, using the old value with a stateful action +-- | Update nested fields, using the old value with a stateful action +-- The selector path will be created if non-existing. modifyField :: (HasCallStack, MakesValue a, ToJSON b) => String -> (Maybe Value -> App b) -> a -> App Value modifyField selector up x = do v <- make x @@ -268,7 +270,7 @@ modifyField selector up x = do newValue <- toJSON <$> up (KM.lookup k' ob) pure $ Object $ KM.insert k' newValue ob go k (k2 : ks) v = do - val <- v %. k + val <- fromMaybe (Object $ KM.empty) <$> lookupField v k newValue <- go k2 ks val ob <- asObject v pure $ Object $ KM.insert (KM.fromString k) newValue ob @@ -339,9 +341,9 @@ objQid ob = do Just v -> pure v where select x = runMaybeT $ do - vdom <- MaybeT $ lookupField x "domain" + vdom <- lookupFieldM x "domain" dom <- MaybeT $ asStringM vdom - vid <- MaybeT $ lookupField x "id" + vid <- lookupFieldM x "id" id_ <- MaybeT $ asStringM vid pure (dom, id_) diff --git a/services/brig/test/integration/API/Calling.hs b/services/brig/test/integration/API/Calling.hs index ec163beb58e..b6a355b1264 100644 --- a/services/brig/test/integration/API/Calling.hs +++ b/services/brig/test/integration/API/Calling.hs @@ -35,7 +35,6 @@ import Data.Misc (Port (..), mkHttpsUrl) import Data.Set qualified as Set import Imports import System.FilePath (()) -import System.IO (hPutStr) import Test.Tasty import Test.Tasty.HUnit import URI.ByteString (laxURIParserOptions, parseURI) @@ -61,10 +60,7 @@ tests m b opts turn turnV2 = do "sft" [ test m "SFT servers /calls/config/v2 - 200" $ testSFT b opts, test m "SFT servers /calls/config/v2 - 200 - SFT does not respond as expected" $ testSFTUnavailable b opts "https://example.com", - test m "SFT servers /calls/config/v2 - 200 - SFT DNS does not resolve" $ testSFTUnavailable b opts "https://sft.example.com", - test m "SFT credentials with SFT secret /calls/config/authenticated - 200" $ testSFTCredentials b opts, - test m "No SFT credentials without SFT secret /calls/config/authenticated - 200" $ testSFTNoCredentials b opts, - test m "SFT federation /calls/config/authenticated - 200" $ testSFTFederation b opts + test m "SFT servers /calls/config/v2 - 200 - SFT DNS does not resolve" $ testSFTUnavailable b opts "https://sft.example.com" ] ] @@ -116,123 +112,6 @@ testSFT b opts = do (Set.fromList [sftServer server1, sftServer server2]) (Set.fromList $ maybe [] NonEmpty.toList $ cfg1 ^. rtcConfSftServers) --- | This test relies on pre-created public DNS records. Code here: --- https://github.com/zinfra/cailleach/blob/fb4caacaca02e6e28d68dc0cdebbbc987f5e31da/targets/misc/wire-server-integration-tests/dns.tf -testSFTCredentials :: Brig -> Opts.Opts -> Http () -testSFTCredentials b opts = do - uid <- userId <$> randomUser b - cid <- randomClient - let ttl = 60 - secondsToNew = 30 - liftIO $ Temp.withSystemTempFile "sft-secret" $ \secretFile secretHandle -> do - hPutStr secretHandle "xMtZyTpu=Leb?YKCoq#BXQR:gG^UrE83dNWzFJ2VcD" - hClose secretHandle - withSettingsOverrides - ( opts - & Opts.sftL - ?~ Opts.SFTOptions - "integration-tests.zinfra.io" - Nothing - (Just 0.001) - Nothing - (Just $ Opts.SFTTokenOptions ttl secretFile secondsToNew) - & Opts.optionSettings . Opts.sftListAllServers ?~ Opts.ListAllSFTServers - ) - $ do - allSFTServers <- fromMaybe [] . (^. rtcConfSftServersAll) <$> retryWhileN 10 (isNothing . view rtcConfSftServers) (getTurnConfigurationAuthenticated uid cid b) - -- These values are controlled by https://github.com/zinfra/cailleach/tree/77ca2d23cf2959aa183dd945d0a0b13537a8950d/environments/dns-integration-tests - let Right server1 = mkHttpsUrl =<< first show (parseURI laxURIParserOptions "https://sft01.integration-tests.zinfra.io:443") - let Right server2 = mkHttpsUrl =<< first show (parseURI laxURIParserOptions "https://sft02.integration-tests.zinfra.io:8443") - liftIO $ - assertEqual - "when list_all_sft_servers is enabled, sft_servers_all should be returned" - (Set.fromList [server1, server2]) - (Set.fromList $ map (^. authURL) allSFTServers) - liftIO $ - assertBool - "when SFT secret is defined, a username should be returned for each SFT server" - (all (isJust . (^. authUsername)) allSFTServers) - liftIO $ - assertBool - "when SFT secret is defined, a credential should be returned for each SFT server" - (all (isJust . (^. authCredential)) allSFTServers) - --- | This test relies on pre-created public DNS records. Code here: --- https://github.com/zinfra/cailleach/blob/fb4caacaca02e6e28d68dc0cdebbbc987f5e31da/targets/misc/wire-server-integration-tests/dns.tf -testSFTNoCredentials :: Brig -> Opts.Opts -> Http () -testSFTNoCredentials b opts = do - uid <- userId <$> randomUser b - cid <- randomClient - withSettingsOverrides - ( opts - & Opts.sftL - ?~ Opts.SFTOptions - "integration-tests.zinfra.io" - Nothing - (Just 0.001) - Nothing - Nothing - & Opts.optionSettings . Opts.sftListAllServers ?~ Opts.ListAllSFTServers - ) - $ do - allSFTServers <- fromMaybe [] . (^. rtcConfSftServersAll) <$> retryWhileN 10 (isNothing . view rtcConfSftServers) (getTurnConfigurationAuthenticated uid cid b) - -- These values are controlled by https://github.com/zinfra/cailleach/tree/77ca2d23cf2959aa183dd945d0a0b13537a8950d/environments/dns-integration-tests - let Right server1 = mkHttpsUrl =<< first show (parseURI laxURIParserOptions "https://sft01.integration-tests.zinfra.io:443") - let Right server2 = mkHttpsUrl =<< first show (parseURI laxURIParserOptions "https://sft02.integration-tests.zinfra.io:8443") - liftIO $ - assertEqual - "when list_all_sft_servers is enabled, sft_servers_all should be returned" - (Set.fromList [server1, server2]) - (Set.fromList $ map (^. authURL) allSFTServers) - liftIO $ - assertBool - "when SFT secret is defined, a username should be returned for each SFT server" - (all (isNothing . (^. authUsername)) allSFTServers) - liftIO $ - assertBool - "when SFT secret is defined, a credential should be returned for each SFT server" - (all (isNothing . (^. authCredential)) allSFTServers) - --- | This test relies on pre-created public DNS records. Code here: --- https://github.com/zinfra/cailleach/blob/fb4caacaca02e6e28d68dc0cdebbbc987f5e31da/targets/misc/wire-server-integration-tests/dns.tf -testSFTFederation :: Brig -> Opts.Opts -> Http () -testSFTFederation b opts = do - uid <- userId <$> randomUser b - cid <- randomClient - withSettingsOverrides - ( opts - & Opts.multiSFTL .~ Nothing - & Opts.sftL ?~ Opts.SFTOptions "integration-tests.zinfra.io" Nothing (Just 0.001) Nothing Nothing - ) - $ do - isFederating <- (^. rtcConfIsFederating) <$> retryWhileN 10 (isNothing . view rtcConfSftServers) (getTurnConfigurationAuthenticated uid cid b) - liftIO $ - assertBool - "SFT federation is not defined" - (isNothing isFederating) - withSettingsOverrides - ( opts - & Opts.multiSFTL ?~ True - & Opts.sftL ?~ Opts.SFTOptions "integration-tests.zinfra.io" Nothing (Just 0.001) Nothing Nothing - ) - $ do - isFederating <- (^. rtcConfIsFederating) <$> retryWhileN 10 (isNothing . view rtcConfSftServers) (getTurnConfigurationAuthenticated uid cid b) - liftIO $ - assertBool - "SFT federation is defined and true" - (fromMaybe False isFederating) - withSettingsOverrides - ( opts - & Opts.multiSFTL ?~ False - & Opts.sftL ?~ Opts.SFTOptions "integration-tests.zinfra.io" Nothing (Just 0.001) Nothing Nothing - ) - $ do - isFederating <- (^. rtcConfIsFederating) <$> retryWhileN 10 (isNothing . view rtcConfSftServers) (getTurnConfigurationAuthenticated uid cid b) - liftIO $ - assertBool - "SFT federation is defined and false" - (not $ fromMaybe False isFederating) - testSFTUnavailable :: Brig -> Opts.Opts -> String -> Http () testSFTUnavailable b opts domain = do uid <- userId <$> randomUser b @@ -300,7 +179,7 @@ testCallsConfigSRV b opts = do config <- withSettingsOverrides (opts & Opts.turnL . Opts.serversSourceL .~ dnsOpts) $ responseJsonError - =<< ( retryWhileN 10 (\r -> statusCode r /= 200) (getTurnConfiguration "" uid Nothing b) + =<< ( retryWhileN 10 (\r -> statusCode r /= 200) (getTurnConfiguration "" uid b) statusCode r /= 200) (getTurnConfiguration "v2" uid Nothing b) + =<< ( retryWhileN 10 (\r -> statusCode r /= 200) (getTurnConfiguration "v2" uid b) Brig -> Http RTCConfiguration -getTurnConfigurationV1 = flip (getAndValidateTurnConfiguration "") Nothing +getTurnConfigurationV1 = getAndValidateTurnConfiguration "" getTurnConfigurationV2 :: HasCallStack => UserId -> Brig -> ((MonadHttp m, MonadIO m, MonadCatch m) => m RTCConfiguration) -getTurnConfigurationV2 = flip (getAndValidateTurnConfiguration "v2") Nothing - -getTurnConfigurationAuthenticated :: HasCallStack => UserId -> ClientId -> Brig -> ((MonadHttp m, MonadIO m, MonadCatch m) => m RTCConfiguration) -getTurnConfigurationAuthenticated u = getAndValidateTurnConfiguration "authenticated" u . Just +getTurnConfigurationV2 = getAndValidateTurnConfiguration "v2" -getTurnConfiguration :: ByteString -> UserId -> Maybe ClientId -> Brig -> (MonadHttp m => m (Response (Maybe LB.ByteString))) -getTurnConfiguration suffix u mc b = +getTurnConfiguration :: ByteString -> UserId -> Brig -> (MonadHttp m => m (Response (Maybe LB.ByteString))) +getTurnConfiguration suffix u b = get ( b . paths ["/calls/config", suffix] . zUser u - . maybe id zClient mc . zConn "conn" ) -getAndValidateTurnConfiguration :: HasCallStack => ByteString -> UserId -> Maybe ClientId -> Brig -> ((MonadIO m, MonadHttp m, MonadCatch m) => m RTCConfiguration) -getAndValidateTurnConfiguration suffix u mc b = - responseJsonError =<< (getTurnConfiguration suffix u mc b ByteString -> UserId -> Brig -> ((MonadIO m, MonadHttp m, MonadCatch m) => m RTCConfiguration) +getAndValidateTurnConfiguration suffix u b = + responseJsonError =<< (getTurnConfiguration suffix u b UserId -> Brig -> Http (Response (Maybe LB.ByteString)) getTurnConfigurationV2Limit limit u b = From 9530c8cbd411d68ec11d58401ebb40f18e356a5a Mon Sep 17 00:00:00 2001 From: Stefan Berthold Date: Thu, 4 Apr 2024 10:20:23 +0000 Subject: [PATCH 11/12] fix MLS integration tests --- services/brig/src/Brig/Effects/SFTStore/Cassandra.hs | 2 +- services/galley/src/Galley/Cassandra/Conversation/MLS.hs | 3 +-- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/services/brig/src/Brig/Effects/SFTStore/Cassandra.hs b/services/brig/src/Brig/Effects/SFTStore/Cassandra.hs index 3da67157827..b638a79a97a 100644 --- a/services/brig/src/Brig/Effects/SFTStore/Cassandra.hs +++ b/services/brig/src/Brig/Effects/SFTStore/Cassandra.hs @@ -59,7 +59,7 @@ interpretSFTStoreToConstant = checkTransSuccess :: [Row] -> Bool checkTransSuccess [] = False -checkTransSuccess (row : _) = fromMaybe False . hush $ fromRow 0 row +checkTransSuccess (row : _) = either (const False) (fromMaybe False) $ fromRow 0 row storeCredential :: MonadClient m => UserId -> ClientId -> SFTUsername -> AsciiBase64 -> Int32 -> m Bool storeCredential u c username credential ttl = diff --git a/services/galley/src/Galley/Cassandra/Conversation/MLS.hs b/services/galley/src/Galley/Cassandra/Conversation/MLS.hs index 56eae0325f1..fbc2991247d 100644 --- a/services/galley/src/Galley/Cassandra/Conversation/MLS.hs +++ b/services/galley/src/Galley/Cassandra/Conversation/MLS.hs @@ -26,7 +26,6 @@ where import Cassandra import Cassandra.Settings import Control.Arrow -import Control.Error import Data.Time import Galley.API.MLS.Types import Galley.Cassandra.Queries qualified as Cql @@ -64,7 +63,7 @@ releaseCommitLock groupId epoch = checkTransSuccess :: [Row] -> Bool checkTransSuccess [] = False -checkTransSuccess (row : _) = fromMaybe False . hush $ fromRow 0 row +checkTransSuccess (row : _) = either (const False) (fromMaybe False) $ fromRow 0 row lookupMLSClientLeafIndices :: GroupId -> Client (ClientMap, IndexMap) lookupMLSClientLeafIndices groupId = do From f74a574484078a9237fb46cf7ae1e424e0af386e Mon Sep 17 00:00:00 2001 From: Stefan Berthold Date: Tue, 9 Apr 2024 13:19:36 +0000 Subject: [PATCH 12/12] remove "rate-limiting" via Cassandra --- cassandra-schema.cql | 26 ----- changelog.d/0-release-notes/WPB-227 | 15 +-- changelog.d/1-api-changes/WPB-227 | 12 -- charts/brig/templates/configmap.yaml | 1 - .../src/developer/reference/config-options.md | 5 +- integration/test/API/Brig.hs | 9 +- integration/test/Test/Brig.hs | 19 +-- libs/wire-api/src/Wire/API/Call/Config.hs | 8 +- .../src/Wire/API/Routes/Public/Brig.hs | 16 --- services/brig/brig.cabal | 3 - services/brig/src/Brig/API/Public.hs | 3 - services/brig/src/Brig/Calling.hs | 4 +- services/brig/src/Brig/Calling/API.hs | 75 ++---------- .../brig/src/Brig/CanonicalInterpreter.hs | 4 - services/brig/src/Brig/Effects/SFTStore.hs | 40 ------- .../src/Brig/Effects/SFTStore/Cassandra.hs | 108 ------------------ services/brig/src/Brig/Options.hs | 4 +- services/brig/src/Brig/Schema/Run.hs | 4 +- .../src/Brig/Schema/V82_AddSFTCredentials.hs | 44 ------- services/brig/test/unit/Test/Brig/Calling.hs | 14 +-- 20 files changed, 41 insertions(+), 373 deletions(-) delete mode 100644 changelog.d/1-api-changes/WPB-227 delete mode 100644 services/brig/src/Brig/Effects/SFTStore.hs delete mode 100644 services/brig/src/Brig/Effects/SFTStore/Cassandra.hs delete mode 100644 services/brig/src/Brig/Schema/V82_AddSFTCredentials.hs diff --git a/cassandra-schema.cql b/cassandra-schema.cql index 98642464aa4..a35870fedfd 100644 --- a/cassandra-schema.cql +++ b/cassandra-schema.cql @@ -789,32 +789,6 @@ CREATE TABLE brig_test.prekeys ( AND read_repair_chance = 0.0 AND speculative_retry = '99PERCENTILE'; -CREATE TABLE brig_test.sft_credential ( - user uuid, - client text, - credential ascii, - expiry varint, - key_index bigint, - random text, - s boolean, - version bigint, - PRIMARY KEY (user, client) -) WITH CLUSTERING ORDER BY (client ASC) - AND bloom_filter_fp_chance = 0.01 - AND caching = {'keys': 'ALL', 'rows_per_partition': 'NONE'} - AND comment = '' - AND compaction = {'class': 'org.apache.cassandra.db.compaction.SizeTieredCompactionStrategy', 'max_threshold': '32', 'min_threshold': '4'} - AND compression = {'chunk_length_in_kb': '64', 'class': 'org.apache.cassandra.io.compress.LZ4Compressor'} - AND crc_check_chance = 1.0 - AND dclocal_read_repair_chance = 0.1 - AND default_time_to_live = 0 - AND gc_grace_seconds = 864000 - AND max_index_interval = 2048 - AND memtable_flush_period_in_ms = 0 - AND min_index_interval = 128 - AND read_repair_chance = 0.0 - AND speculative_retry = '99PERCENTILE'; - CREATE TABLE brig_test.oauth_auth_code ( code ascii PRIMARY KEY, client uuid, diff --git a/changelog.d/0-release-notes/WPB-227 b/changelog.d/0-release-notes/WPB-227 index 876df5be115..4d5c5989a39 100644 --- a/changelog.d/0-release-notes/WPB-227 +++ b/changelog.d/0-release-notes/WPB-227 @@ -1,6 +1,6 @@ There is a new optional Boolean option, `multiSFT.enabled`, in `brig.yaml`, allowing calls between federated SFT servers. If provided, the field -`is_federating` in the response of `/calls/config/authenticated` will reflect +`is_federating` in the response of `/calls/config/v2` will reflect `multiSFT.enabled`'s value. Example: @@ -11,13 +11,11 @@ multiSFT: enabled: true ``` -Also, the optional object `sftToken` with its fields `ttl`, `secret`, and -`secondsBeforeNew` define whether an SFT credential would be rendered in the -response of `/calls/config/authenticated`. The field `ttl` determines the -seconds for the credential to be valid, `secondsBeforeNew` determines the amount -of time which has to pass before a new token will be generated, preventing one -client to create too many new credentials, and `secret` is the path to the -secret shared with SFT to create credentials. +Also, the optional object `sftToken` with its fields `ttl` and `secret` define +whether an SFT credential would be rendered in the response of +`/calls/config/v2`. The field `ttl` determines the seconds for the credential to +be valid and `secret` is the path to the secret shared with SFT to create +credentials. Example: @@ -31,5 +29,4 @@ sft: sftToken: ttl: 120 secret: /path/to/secret - secondsBeforeNew: 60 ``` diff --git a/changelog.d/1-api-changes/WPB-227 b/changelog.d/1-api-changes/WPB-227 deleted file mode 100644 index a5f99bf5841..00000000000 --- a/changelog.d/1-api-changes/WPB-227 +++ /dev/null @@ -1,12 +0,0 @@ -The new endpoint `/calls/config/authenticated` returns the same data as -`/calls/config/v2` and in addition features a new optional field `is_federating` -which reflects whether SFT federation is enabled or not. Also, the new optional -fields `username` and `credential` in the `sft_servers_all` object of the -endpoint's response provide the SFT credential which the authenticated client -should use for connecting to SFT. The credential will only be generated if a -secret shared between SFT and Brig has been configured for Brig. Repeated calls -to the endpoint will not lead to newly issued SFT credentials until a configured -timespan has been elapsed. During this timespan, the already provided SFT -credential will be replayed in the endpoint's response. For this to work, -clients have to send the `Z-Client` header in their requests to this new -endpoint. diff --git a/charts/brig/templates/configmap.yaml b/charts/brig/templates/configmap.yaml index e260584699e..171ae2373d4 100644 --- a/charts/brig/templates/configmap.yaml +++ b/charts/brig/templates/configmap.yaml @@ -215,7 +215,6 @@ data: {{- with .sftToken }} ttl: {{ .ttl }} secret: {{ .secret }} - secondsBeforeNew: {{ .secondsBeforeNew }} {{- end }} {{- end }} {{- end }} diff --git a/docs/src/developer/reference/config-options.md b/docs/src/developer/reference/config-options.md index a472fe543e1..0823bc3d0e2 100644 --- a/docs/src/developer/reference/config-options.md +++ b/docs/src/developer/reference/config-options.md @@ -517,7 +517,7 @@ This setting assumes that the sft load balancer has been deployed with the `sftd Additionally if `setSftListAllServers` is set to `enabled` (disabled by default) then the `/calls/config/v2` endpoint will include a list of all servers that are load balanced by `setSftStaticUrl` at field `sft_servers_all`. This is required to enable calls between federated instances of Wire. -Calls between federated SFT servers can be enabled using the optional boolean `multiSFT.enabled`. If provided, the field `is_federating` in the response of `/calls/config/authenticated` will reflect `multiSFT.enabled`'s value. +Calls between federated SFT servers can be enabled using the optional boolean `multiSFT.enabled`. If provided, the field `is_federating` in the response of `/calls/config/v2` will reflect `multiSFT.enabled`'s value. ``` # [brig.yaml] @@ -525,7 +525,7 @@ multiSFT: enabled: true ``` -Also, the optional object `sftToken` with its fields `ttl`, `secret`, and `secondsBeforeNew` define whether an SFT credential would be rendered in the response of `/calls/config/authenticated`. The field `ttl` determines the seconds for the credential to be valid, `secondsBeforeNew` determines the amount of time which has to pass before a new token will be generated, preventing one client to create too many new credentials, and `secret` is the path to the secret shared with SFT to create credentials. +Also, the optional object `sftToken` with its fields `ttl` and `secret` define whether an SFT credential would be rendered in the response of `/calls/config/v2`. The field `ttl` determines the seconds for the credential to be valid and `secret` is the path to the secret shared with SFT to create credentials. Example: @@ -539,7 +539,6 @@ sft: sftToken: ttl: 120 secret: /path/to/secret - secondsBeforeNew: 60 ``` ### Locale diff --git a/integration/test/API/Brig.hs b/integration/test/API/Brig.hs index 8f310f0c731..ff825f0aa90 100644 --- a/integration/test/API/Brig.hs +++ b/integration/test/API/Brig.hs @@ -638,8 +638,7 @@ renewToken caller cookie = do submit "POST" (addHeader "Cookie" ("zuid=" <> cookie) req) -- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/get_calls_config_v2 -getCallsConfigAuthenticated :: (HasCallStack, MakesValue user, MakesValue client) => user -> client -> App Response -getCallsConfigAuthenticated user client = do - cli <- client & objId - req <- baseRequest user Brig Versioned $ joinHttpPath ["calls", "config", "authenticated"] - submit "GET" $ zClient cli req +getCallsConfigV2 :: (HasCallStack, MakesValue user) => user -> App Response +getCallsConfigV2 user = do + req <- baseRequest user Brig Versioned $ joinHttpPath ["calls", "config", "v2"] + submit "GET" req diff --git a/integration/test/Test/Brig.hs b/integration/test/Test/Brig.hs index 408fea5e540..0feb154388e 100644 --- a/integration/test/Test/Brig.hs +++ b/integration/test/Test/Brig.hs @@ -1,6 +1,6 @@ module Test.Brig where -import API.Brig (getCallsConfigAuthenticated) +import API.Brig import qualified API.BrigInternal as BrigI import API.Common import Data.Aeson.Types hiding ((.=)) @@ -132,7 +132,6 @@ testCrudFederationRemoteTeams = do testSFTCredentials :: HasCallStack => App () testSFTCredentials = do let ttl = (60 :: Int) - secondsToNew = (30 :: Int) withSystemTempFile "sft-secret" $ \secretFile secretHandle -> do liftIO $ do hPutStr secretHandle "xMtZyTpu=Leb?YKCoq#BXQR:gG^UrE83dNWzFJ2VcD" @@ -143,15 +142,13 @@ testSFTCredentials = do ( setField "sft.sftBaseDomain" "integration-tests.zinfra.io" . setField "sft.sftToken.ttl" ttl . setField "sft.sftToken.secret" secretFile - . setField "sft.sftToken.secondsBeforeNew" secondsToNew . setField "optSettings.setSftListAllServers" "enabled" ) } ) $ \domain -> do user <- randomUser domain def - client <- randomClientId - bindResponse (getCallsConfigAuthenticated user client) \resp -> do + bindResponse (getCallsConfigV2 user) \resp -> do sftServersAll <- resp.json %. "sft_servers_all" & asList when (null sftServersAll) $ assertFailure "sft_servers_all missing" for_ sftServersAll $ \s -> do @@ -178,8 +175,7 @@ testSFTNoCredentials = withModifiedBackend ) $ \domain -> do user <- randomUser domain def - client <- randomClientId - bindResponse (getCallsConfigAuthenticated user client) \resp -> do + bindResponse (getCallsConfigV2 user) \resp -> do sftServersAll <- resp.json %. "sft_servers_all" & asList when (null sftServersAll) $ assertFailure "sft_servers_all missing" for_ sftServersAll $ \s -> do @@ -200,8 +196,7 @@ testSFTFederation = do ) $ \domain -> do user <- randomUser domain def - client <- randomClientId - bindResponse (getCallsConfigAuthenticated user client) \resp -> do + bindResponse (getCallsConfigV2 user) \resp -> do isFederatingM <- lookupField resp.json "is_federating" when (isJust isFederatingM) $ assertFailure "is_federating should not be present" withModifiedBackend @@ -214,8 +209,7 @@ testSFTFederation = do ) $ \domain -> do user <- randomUser domain def - client <- randomClientId - bindResponse (getCallsConfigAuthenticated user client) \resp -> do + bindResponse (getCallsConfigV2 user) \resp -> do isFederating <- maybe (assertFailure "is_federating missing") asBool =<< lookupField resp.json "is_federating" @@ -230,8 +224,7 @@ testSFTFederation = do ) $ \domain -> do user <- randomUser domain def - client <- randomClientId - bindResponse (getCallsConfigAuthenticated user client) \resp -> do + bindResponse (getCallsConfigV2 user) \resp -> do isFederating <- maybe (assertFailure "is_federating missing") asBool =<< lookupField resp.json "is_federating" diff --git a/libs/wire-api/src/Wire/API/Call/Config.hs b/libs/wire-api/src/Wire/API/Call/Config.hs index a327592837b..442f81fd4af 100644 --- a/libs/wire-api/src/Wire/API/Call/Config.hs +++ b/libs/wire-api/src/Wire/API/Call/Config.hs @@ -54,7 +54,7 @@ module Wire.API.Call.Config suExpiresAt, suVersion, suKeyindex, - suS, + suShared, suRandom, -- * TurnUsername @@ -453,7 +453,7 @@ data SFTUsername = SFTUsername -- | seems to large, but uint32_t is used in C _suKeyindex :: Word32, -- | whether the user is allowed to initialise an SFT conference - _suS :: Bool, + _suShared :: Bool, -- | [a-z0-9]+ _suRandom :: Text } @@ -467,7 +467,7 @@ mkSFTUsername expires rnd = { _suExpiresAt = expires, _suVersion = 1, _suKeyindex = 0, - _suS = True, + _suShared = True, _suRandom = rnd } @@ -489,7 +489,7 @@ instance BC.ToByteString SFTUsername where <> shortByteString ".k=" <> word32Dec (_suKeyindex su) <> shortByteString ".s=" - <> wordDec (boolToWord $ _suS su) + <> wordDec (boolToWord $ _suShared su) <> shortByteString ".r=" <> byteString (view (re utf8) (_suRandom su)) where diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index f3b48803b85..0cd23b3c3e3 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -1548,22 +1548,6 @@ type CallingAPI = :> QueryParam' '[Optional, Strict, Description "Limit resulting list. Allowed values [1..10]"] "limit" (Range 1 10 Int) :> Get '[JSON] RTCConfiguration ) - :<|> Named - "get-authenticated-calls-config" - ( Summary - "Retrieve all TURN server addresses and credentials. \ - \Clients are expected to do a DNS lookup to resolve \ - \the IP addresses of the given hostnames " - :> From 'V6 - :> ZUser - :> ZClient - :> ZConn - :> "calls" - :> "config" - :> "authenticated" - :> QueryParam' '[Optional, Strict, Description "Limit resulting list. Allowed values [1..10]"] "limit" (Range 1 10 Int) - :> Get '[JSON] RTCConfiguration - ) -- Teams API ----------------------------------------------------- diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal index 2486e7ce081..4e0c272153d 100644 --- a/services/brig/brig.cabal +++ b/services/brig/brig.cabal @@ -136,8 +136,6 @@ library Brig.Effects.PasswordResetStore.CodeStore Brig.Effects.PublicKeyBundle Brig.Effects.SFT - Brig.Effects.SFTStore - Brig.Effects.SFTStore.Cassandra Brig.Effects.UserPendingActivationStore Brig.Effects.UserPendingActivationStore.Cassandra Brig.Email @@ -205,7 +203,6 @@ library Brig.Schema.V79_ConnectionRemoteIndex Brig.Schema.V80_KeyPackageCiphersuite Brig.Schema.V81_AddFederationRemoteTeams - Brig.Schema.V82_AddSFTCredentials Brig.Schema.V_FUTUREWORK Brig.SMTP Brig.Team.API diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index a3ef72981fc..c72ee3d2db8 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -56,7 +56,6 @@ import Brig.Effects.JwtTools (JwtTools) import Brig.Effects.PasswordResetStore (PasswordResetStore) import Brig.Effects.PublicKeyBundle (PublicKeyBundle) import Brig.Effects.SFT -import Brig.Effects.SFTStore import Brig.Effects.UserPendingActivationStore (UserPendingActivationStore) import Brig.Options hiding (internalEvents, sesQueue) import Brig.Provider.API @@ -286,7 +285,6 @@ servantSitemap :: Member PasswordResetStore r, Member PublicKeyBundle r, Member SFT r, - Member SFTStore r, Member TinyLog r, Member (UserPendingActivationStore p) r ) => @@ -441,7 +439,6 @@ servantSitemap = callingAPI = Named @"get-calls-config" Calling.getCallsConfig :<|> Named @"get-calls-config-v2" Calling.getCallsConfigV2 - :<|> Named @"get-authenticated-calls-config" Calling.getAuthenticatedCallsConfig systemSettingsAPI :: ServerT SystemSettingsAPI (Handler r) systemSettingsAPI = diff --git a/services/brig/src/Brig/Calling.hs b/services/brig/src/Brig/Calling.hs index da1c183d4d7..49c79b0a9de 100644 --- a/services/brig/src/Brig/Calling.hs +++ b/services/brig/src/Brig/Calling.hs @@ -189,8 +189,7 @@ data SFTTokenEnv = SFTTokenEnv { sftTokenTTL :: Word32, sftTokenSecret :: ByteString, sftTokenPRNG :: GenIO, - sftTokenSHA :: Digest, - sftTokenSecondsBeforeNew :: Int32 + sftTokenSHA :: Digest } mkSFTDomain :: SFTOptions -> DNS.Domain @@ -216,7 +215,6 @@ mkSFTTokenEnv digest opts = <$> BS.readFile (Opts.sttSecret opts) <*> createSystemRandom <*> pure digest - <*> pure (Opts.sttSecondsBeforeNew opts) -- | Start SFT service discovery synchronously startSFTServiceDiscovery :: Log.Logger -> SFTEnv -> IO () diff --git a/services/brig/src/Brig/Calling/API.hs b/services/brig/src/Brig/Calling/API.hs index 2389c7895aa..998b92ee874 100644 --- a/services/brig/src/Brig/Calling/API.hs +++ b/services/brig/src/Brig/Calling/API.hs @@ -21,7 +21,6 @@ module Brig.Calling.API ( getCallsConfig, getCallsConfigV2, - getAuthenticatedCallsConfig, -- * Exposed for testing purposes newConfig, @@ -37,7 +36,6 @@ import Brig.Calling import Brig.Calling qualified as Calling import Brig.Calling.Internal import Brig.Effects.SFT -import Brig.Effects.SFTStore import Brig.Options (ListAllSFTServers (..)) import Brig.Options qualified as Opt import Control.Error (hush, throwE) @@ -61,43 +59,10 @@ import System.Random.MWC qualified as MWC import Wire.API.Call.Config qualified as Public import Wire.Network.DNS.SRV (srvTarget) --- | ('UserId', 'ConnId' are required as args here to make sure this is an authenticated end-point.) -getAuthenticatedCallsConfig :: - ( Member (Embed IO) r, - Member SFT r, - Member SFTStore r - ) => - UserId -> - ClientId -> - ConnId -> - Maybe (Range 1 10 Int) -> - (Handler r) Public.RTCConfiguration -getAuthenticatedCallsConfig u c _ limit = do - env <- view turnEnv - staticUrl <- view $ settings . Opt.sftStaticUrl - sftListAllServers <- fromMaybe Opt.HideAllSFTServers <$> view (settings . Opt.sftListAllServers) - sftEnv' <- view sftEnv - sftFederation <- view enableSFTFederation - discoveredServers <- turnServersV2 (env ^. turnServers) - eitherConfig <- - lift - . liftSem - . Polysemy.runError - $ newConfig - env - discoveredServers - staticUrl - sftEnv' - limit - sftListAllServers - (AuthenticatedCallsConfig u c sftFederation) - handleNoTurnServers eitherConfig - -- | ('UserId', 'ConnId' are required as args here to make sure this is an authenticated end-point.) getCallsConfigV2 :: ( Member (Embed IO) r, - Member SFT r, - Member SFTStore r + Member SFT r ) => UserId -> ConnId -> @@ -108,12 +73,13 @@ getCallsConfigV2 _ _ limit = do staticUrl <- view $ settings . Opt.sftStaticUrl sftListAllServers <- fromMaybe Opt.HideAllSFTServers <$> view (settings . Opt.sftListAllServers) sftEnv' <- view sftEnv + sftFederation <- view enableSFTFederation discoveredServers <- turnServersV2 (env ^. turnServers) eitherConfig <- lift . liftSem . Polysemy.runError - $ newConfig env discoveredServers staticUrl sftEnv' limit sftListAllServers CallsConfigV2 + $ newConfig env discoveredServers staticUrl sftEnv' limit sftListAllServers (CallsConfigV2 sftFederation) handleNoTurnServers eitherConfig -- | Throws '500 Internal Server Error' when no turn servers are found. This is @@ -130,8 +96,7 @@ handleNoTurnServers (Left NoTurnServers) = do getCallsConfig :: ( Member (Embed IO) r, - Member SFT r, - Member SFTStore r + Member SFT r ) => UserId -> ConnId -> @@ -156,8 +121,7 @@ getCallsConfig _ _ = do data CallsConfigVersion = CallsConfigDeprecated - | CallsConfigV2 - | AuthenticatedCallsConfig UserId ClientId (Maybe Bool) + | CallsConfigV2 (Maybe Bool) data NoTurnServers = NoTurnServers deriving (Show) @@ -172,7 +136,6 @@ instance Exception NoTurnServers newConfig :: ( Member (Embed IO) r, Member SFT r, - Member SFTStore r, Member (Polysemy.Error NoTurnServers) r ) => Calling.TurnEnv -> @@ -209,22 +172,16 @@ newConfig env discoveredServers sftStaticUrl mSftEnv limit listAllServers versio let sftFederation' = case version of CallsConfigDeprecated -> Nothing - CallsConfigV2 -> Nothing - AuthenticatedCallsConfig _ _ fed -> fed + CallsConfigV2 fed -> fed mSftServersAll <- case version of CallsConfigDeprecated -> pure Nothing - CallsConfigV2 -> - case (listAllServers, sftStaticUrl) of - (HideAllSFTServers, _) -> pure Nothing - (ListAllSFTServers, Nothing) -> pure . pure $ Public.nauthSFTServer . sftServerFromSrvTarget . srvTarget <$> maybe [] toList allSrvEntries - (ListAllSFTServers, Just url) -> Public.nauthSFTServer <$$$> (hush . unSFTGetResponse <$> sftGetAllServers url) - AuthenticatedCallsConfig u c _ -> + CallsConfigV2 _ -> case (listAllServers, sftStaticUrl) of (HideAllSFTServers, _) -> pure Nothing - (ListAllSFTServers, Nothing) -> mapM (mapM $ authenticate u c) . pure $ sftServerFromSrvTarget . srvTarget <$> maybe [] toList allSrvEntries - (ListAllSFTServers, Just url) -> mapM (mapM $ authenticate u c) . hush . unSFTGetResponse =<< sftGetAllServers url + (ListAllSFTServers, Nothing) -> mapM (mapM authenticate) . pure $ sftServerFromSrvTarget . srvTarget <$> maybe [] toList allSrvEntries + (ListAllSFTServers, Just url) -> mapM (mapM authenticate) . hush . unSFTGetResponse =<< sftGetAllServers url let mSftServers = staticSft <|> sftServerFromSrvTarget . srvTarget <$$> srvEntries pure $ Public.rtcConfiguration srvs mSftServers (env ^. turnConfigTTL) mSftServersAll sftFederation' @@ -249,23 +206,15 @@ newConfig env discoveredServers sftStaticUrl mSftEnv limit listAllServers versio computeCred :: ToByteString a => Digest -> ByteString -> a -> AsciiBase64 computeCred dig secret = encodeBase64 . hmacBS dig secret . toByteString' authenticate :: - ( Member (Embed IO) r, - Member SFTStore r - ) => - UserId -> - ClientId -> + Member (Embed IO) r => Public.SFTServer -> Sem r Public.AuthSFTServer - authenticate u c = + authenticate = maybe (pure . Public.nauthSFTServer) ( \SFTTokenEnv {..} sftsvr -> do username <- liftIO $ genSFTUsername sftTokenTTL sftTokenPRNG let credential = computeCred sftTokenSHA sftTokenSecret username - void $ sftStoreCredential u c username credential sftTokenSecondsBeforeNew - maybe - (Public.nauthSFTServer sftsvr) - (uncurry (Public.authSFTServer sftsvr)) - <$> sftGetCredential u c + pure $ Public.authSFTServer sftsvr username credential ) (sftToken =<< mSftEnv) diff --git a/services/brig/src/Brig/CanonicalInterpreter.hs b/services/brig/src/Brig/CanonicalInterpreter.hs index 18b0a877937..b23a8c2a6dc 100644 --- a/services/brig/src/Brig/CanonicalInterpreter.hs +++ b/services/brig/src/Brig/CanonicalInterpreter.hs @@ -18,8 +18,6 @@ import Brig.Effects.PasswordResetStore (PasswordResetStore) import Brig.Effects.PasswordResetStore.CodeStore (passwordResetStoreToCodeStore) import Brig.Effects.PublicKeyBundle import Brig.Effects.SFT (SFT, interpretSFT) -import Brig.Effects.SFTStore -import Brig.Effects.SFTStore.Cassandra import Brig.Effects.UserPendingActivationStore (UserPendingActivationStore) import Brig.Effects.UserPendingActivationStore.Cassandra (userPendingActivationStoreToCassandra) import Brig.Options (ImplicitNoFederationRestriction (federationDomainConfig), federationDomainConfigs, federationStrategy) @@ -53,7 +51,6 @@ import Wire.Sem.Paging.Cassandra (InternalPaging) type BrigCanonicalEffects = '[ SFT, - SFTStore, ConnectionStore InternalPaging, Input UTCTime, Input (Local ()), @@ -115,7 +112,6 @@ runBrigToIO e (AppT ma) = do . runInputConst (toLocalUnsafe (e ^. settings . Opt.federationDomain) ()) . runInputSem (embed getCurrentTime) . connectionStoreToCassandra - . interpretSFTStoreToCassandra . interpretSFT (e ^. httpManager) ) ) diff --git a/services/brig/src/Brig/Effects/SFTStore.hs b/services/brig/src/Brig/Effects/SFTStore.hs deleted file mode 100644 index aedaccdfc5a..00000000000 --- a/services/brig/src/Brig/Effects/SFTStore.hs +++ /dev/null @@ -1,40 +0,0 @@ --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2024 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 . -{-# LANGUAGE TemplateHaskell #-} - -module Brig.Effects.SFTStore where - -import Data.Id -import Data.Text.Ascii -import Imports -import Polysemy -import Wire.API.Call.Config - -data SFTStore m a where - SftStoreCredential :: - UserId -> - ClientId -> - SFTUsername -> - AsciiBase64 -> - Int32 -> - SFTStore m Bool - SftGetCredential :: - UserId -> - ClientId -> - SFTStore m (Maybe (SFTUsername, AsciiBase64)) - -makeSem ''SFTStore diff --git a/services/brig/src/Brig/Effects/SFTStore/Cassandra.hs b/services/brig/src/Brig/Effects/SFTStore/Cassandra.hs deleted file mode 100644 index b638a79a97a..00000000000 --- a/services/brig/src/Brig/Effects/SFTStore/Cassandra.hs +++ /dev/null @@ -1,108 +0,0 @@ -{-# LANGUAGE DeepSubsumption #-} - --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2024 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.Effects.SFTStore.Cassandra - ( interpretSFTStoreToCassandra, - interpretSFTStoreToConstant, - ) -where - -import Brig.Effects.SFTStore -import Cassandra -import Cassandra.Settings -import Control.Error -import Control.Lens ((^.)) -import Data.Id -import Data.Text.Ascii -import Data.Time.Clock -import Imports -import Polysemy -import Polysemy.Internal.Tactics -import Wire.API.Call.Config - -interpretSFTStoreToCassandra :: - forall r a. - (Member (Embed Client) r) => - Sem (SFTStore ': r) a -> - Sem r a -interpretSFTStoreToCassandra = - interpretH $ - liftT . embed @Client . \case - SftStoreCredential u c username credential ttl -> storeCredential u c username credential ttl - SftGetCredential u c -> getCredential u c - -interpretSFTStoreToConstant :: - forall r a. - Sem (SFTStore ': r) a -> - Sem r a -interpretSFTStoreToConstant = - interpretH $ - liftT . \case - SftStoreCredential _u _c _username _credential _ttl -> pure True - SftGetCredential _u _c -> pure $ Just (mkSFTUsername 12 "username", "credential") - -checkTransSuccess :: [Row] -> Bool -checkTransSuccess [] = False -checkTransSuccess (row : _) = either (const False) (fromMaybe False) $ fromRow 0 row - -storeCredential :: MonadClient m => UserId -> ClientId -> SFTUsername -> AsciiBase64 -> Int32 -> m Bool -storeCredential u c username credential ttl = - checkTransSuccess - <$> retry - x5 - ( trans - addCredential - ( params - LocalQuorum - ( u, - c, - floor $ nominalDiffTimeToSeconds (username ^. suExpiresAt), - fromIntegral (username ^. suVersion), - fromIntegral (username ^. suKeyindex), - username ^. suS, - username ^. suRandom, - credential, - ttl - ) - ) - { serialConsistency = Just LocalSerialConsistency - } - ) - where - addCredential :: PrepQuery W (UserId, ClientId, Integer, Int64, Int64, Bool, Text, AsciiBase64, Int32) Row - addCredential = "INSERT INTO sft_credential (user, client, expiry, version, key_index, s, random, credential) VALUES (?, ?, ?, ?, ?, ?, ?, ?) IF NOT EXISTS USING TTL ?" - -getCredential :: - MonadClient m => - UserId -> - ClientId -> - m (Maybe (SFTUsername, AsciiBase64)) -getCredential u c = mergeColumns <$$> retry x1 (query1 q (params LocalQuorum (u, c))) - where - q :: PrepQuery R (UserId, ClientId) (Integer, Int64, Int64, Bool, Text, AsciiBase64) - q = "SELECT expiry, version, key_index, s, random, credential FROM sft_credential WHERE user = ? AND client = ? LIMIT 1" - mergeColumns (expiry, version, index, s, rand, credential) = - ( SFTUsername - (fromInteger expiry) - (fromIntegral version) - (fromIntegral index) - s - rand, - credential - ) diff --git a/services/brig/src/Brig/Options.hs b/services/brig/src/Brig/Options.hs index 6bc0d584abc..dca9d2b3a18 100644 --- a/services/brig/src/Brig/Options.hs +++ b/services/brig/src/Brig/Options.hs @@ -824,8 +824,7 @@ instance FromJSON SFTOptions where data SFTTokenOptions = SFTTokenOptions { sttTTL :: !Word32, - sttSecret :: !FilePath, - sttSecondsBeforeNew :: !Int32 + sttSecret :: !FilePath } deriving (Show, Generic) @@ -834,7 +833,6 @@ instance FromJSON SFTTokenOptions where SFTTokenOptions <$> (o .: "ttl") <*> (o .: "secret") - <*> (o .: "secondsBeforeNew") asciiOnly :: Text -> Y.Parser ByteString asciiOnly t = diff --git a/services/brig/src/Brig/Schema/Run.hs b/services/brig/src/Brig/Schema/Run.hs index 445828031ff..049a51e5f5f 100644 --- a/services/brig/src/Brig/Schema/Run.hs +++ b/services/brig/src/Brig/Schema/Run.hs @@ -56,7 +56,6 @@ import Brig.Schema.V78_ClientLastActive qualified as V78_ClientLastActive import Brig.Schema.V79_ConnectionRemoteIndex qualified as V79_ConnectionRemoteIndex import Brig.Schema.V80_KeyPackageCiphersuite qualified as V80_KeyPackageCiphersuite import Brig.Schema.V81_AddFederationRemoteTeams qualified as V81_AddFederationRemoteTeams -import Brig.Schema.V82_AddSFTCredentials qualified as V82_AddSFTCredentials import Cassandra.MigrateSchema (migrateSchema) import Cassandra.Schema import Control.Exception (finally) @@ -119,8 +118,7 @@ migrations = V78_ClientLastActive.migration, V79_ConnectionRemoteIndex.migration, V80_KeyPackageCiphersuite.migration, - V81_AddFederationRemoteTeams.migration, - V82_AddSFTCredentials.migration + V81_AddFederationRemoteTeams.migration -- FUTUREWORK: undo V41 (searchable flag); we stopped using it in -- https://github.com/wireapp/wire-server/pull/964 -- diff --git a/services/brig/src/Brig/Schema/V82_AddSFTCredentials.hs b/services/brig/src/Brig/Schema/V82_AddSFTCredentials.hs deleted file mode 100644 index 2f9eba9dd87..00000000000 --- a/services/brig/src/Brig/Schema/V82_AddSFTCredentials.hs +++ /dev/null @@ -1,44 +0,0 @@ -{-# LANGUAGE QuasiQuotes #-} - --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2023 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.Schema.V82_AddSFTCredentials - ( migration, - ) -where - -import Cassandra.Schema -import Imports -import Text.RawString.QQ - -migration :: Migration -migration = - Migration 82 "Add table for keeping track of and rate-limiting issuing new SFT credentials" $ do - schema' - [r| - CREATE TABLE sft_credential - ( user uuid - , client text - , expiry varint - , version bigint - , key_index bigint - , s boolean - , random text - , credential ascii - , PRIMARY KEY (user, client)) - |] diff --git a/services/brig/test/unit/Test/Brig/Calling.hs b/services/brig/test/unit/Test/Brig/Calling.hs index ed5e2bca62a..007a2041743 100644 --- a/services/brig/test/unit/Test/Brig/Calling.hs +++ b/services/brig/test/unit/Test/Brig/Calling.hs @@ -24,7 +24,6 @@ import Brig.Calling import Brig.Calling.API import Brig.Calling.Internal import Brig.Effects.SFT -import Brig.Effects.SFTStore.Cassandra import Brig.Options import Control.Concurrent.Timeout qualified as System import Control.Lens ((^.)) @@ -297,7 +296,6 @@ testSFTStaticDeprecatedEndpoint = do . ignoreLogs . interpretSFTInMemory mempty . throwErrorInIO @_ @NoTurnServers - . interpretSFTStoreToConstant $ newConfig env (Discovered turnUri) Nothing Nothing Nothing HideAllSFTServers CallsConfigDeprecated assertEqual "when SFT static URL is disabled, sft_servers should be empty." @@ -325,8 +323,7 @@ testSFTStaticV2NoStaticUrl = do . ignoreLogs . interpretSFTInMemory mempty . throwErrorInIO @_ @NoTurnServers - . interpretSFTStoreToConstant - $ newConfig env (Discovered turnUri) Nothing (Just sftEnv) (Just . unsafeRange $ 2) ListAllSFTServers CallsConfigV2 + $ newConfig env (Discovered turnUri) Nothing (Just sftEnv) (Just . unsafeRange $ 2) ListAllSFTServers (CallsConfigV2 Nothing) assertEqual "when SFT static URL is disabled, sft_servers_all should be from SFT environment" (Just . fmap ((^. sftURL) . sftServerFromSrvTarget . srvTarget) . toList $ servers) @@ -342,8 +339,7 @@ testSFTStaticV2StaticUrlError = do . ignoreLogs . interpretSFTInMemory mempty -- an empty lookup map, meaning there was an error . throwErrorInIO @_ @NoTurnServers - . interpretSFTStoreToConstant - $ newConfig env (Discovered turnUri) (Just staticUrl) Nothing (Just . unsafeRange $ 2) ListAllSFTServers CallsConfigV2 + $ newConfig env (Discovered turnUri) (Just staticUrl) Nothing (Just . unsafeRange $ 2) ListAllSFTServers (CallsConfigV2 Nothing) assertEqual "when SFT static URL is enabled (and setSftListAllServers is enabled), but returns error, sft_servers_all should be omitted" Nothing @@ -362,8 +358,7 @@ testSFTStaticV2StaticUrlList = do . ignoreLogs . interpretSFTInMemory (Map.singleton staticUrl (SFTGetResponse $ Right servers)) . throwErrorInIO @_ @NoTurnServers - . interpretSFTStoreToConstant - $ newConfig env (Discovered turnUri) (Just staticUrl) Nothing (Just . unsafeRange $ 3) ListAllSFTServers CallsConfigV2 + $ newConfig env (Discovered turnUri) (Just staticUrl) Nothing (Just . unsafeRange $ 3) ListAllSFTServers (CallsConfigV2 Nothing) assertEqual "when SFT static URL and setSftListAllServers are enabled, sft_servers_all should be from /sft_servers_all.json" ((^. sftURL) <$$> Just servers) @@ -381,8 +376,7 @@ testSFTStaticV2ListAllServersDisabled = do . ignoreLogs . interpretSFTInMemory (Map.singleton staticUrl (SFTGetResponse . Right $ servers)) . throwErrorInIO @_ @NoTurnServers - . interpretSFTStoreToConstant - $ newConfig env (Discovered turnUri) (Just staticUrl) Nothing (Just . unsafeRange $ 3) HideAllSFTServers CallsConfigV2 + $ newConfig env (Discovered turnUri) (Just staticUrl) Nothing (Just . unsafeRange $ 3) HideAllSFTServers (CallsConfigV2 Nothing) assertEqual "when SFT static URL is enabled and setSftListAllServers is \"disabled\" then sft_servers_all is missing" Nothing