diff --git a/changelog.d/0-release-notes/WPB-227 b/changelog.d/0-release-notes/WPB-227 new file mode 100644 index 00000000000..4d5c5989a39 --- /dev/null +++ b/changelog.d/0-release-notes/WPB-227 @@ -0,0 +1,32 @@ +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/v2` will reflect +`multiSFT.enabled`'s value. + +Example: + +``` +# [brig.yaml] +multiSFT: + enabled: true +``` + +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: + +``` +# [brig.yaml] +sft: + sftBaseDomain: sft.wire.example.com + sftSRVServiceName: sft + sftDiscoveryIntervalSeconds: 10 + sftListLength: 20 + sftToken: + ttl: 120 + secret: /path/to/secret +``` diff --git a/charts/brig/templates/configmap.yaml b/charts/brig/templates/configmap.yaml index 7065407f57c..171ae2373d4 100644 --- a/charts/brig/templates/configmap.yaml +++ b/charts/brig/templates/configmap.yaml @@ -57,6 +57,7 @@ data: host: gundeck port: 8080 + multiSFT: {{ .multiSFT.enabled }} {{- if .enableFederation }} # TODO remove this federator: @@ -209,6 +210,13 @@ data: {{- if .sftDiscoveryIntervalSeconds }} sftDiscoveryIntervalSeconds: {{ .sftDiscoveryIntervalSeconds }} {{- end }} + {{- if .sftToken }} + sftToken: + {{- with .sftToken }} + ttl: {{ .ttl }} + secret: {{ .secret }} + {{- end }} + {{- end }} {{- end }} {{- end }} diff --git a/charts/brig/templates/tests/configmap.yaml b/charts/brig/templates/tests/configmap.yaml index 56667e55ed3..f4f2ce08fe9 100644 --- a/charts/brig/templates/tests/configmap.yaml +++ b/charts/brig/templates/tests/configmap.yaml @@ -33,6 +33,8 @@ data: host: spar port: 8080 + multiSFT: false + # TODO remove this federator: host: 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/docs/src/developer/reference/config-options.md b/docs/src/developer/reference/config-options.md index d45c805dc65..0823bc3d0e2 100644 --- a/docs/src/developer/reference/config-options.md +++ b/docs/src/developer/reference/config-options.md @@ -517,6 +517,30 @@ 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/v2` will reflect `multiSFT.enabled`'s value. + +``` +# [brig.yaml] +multiSFT: + enabled: true +``` + +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: + +``` +# [brig.yaml] +sft: + sftBaseDomain: sft.wire.example.com + sftSRVServiceName: sft + sftDiscoveryIntervalSeconds: 10 + sftListLength: 20 + sftToken: + ttl: 120 + secret: /path/to/secret +``` + ### Locale 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/integration/test/API/Brig.hs b/integration/test/API/Brig.hs index 908a0db996d..ff825f0aa90 100644 --- a/integration/test/API/Brig.hs +++ b/integration/test/API/Brig.hs @@ -636,3 +636,9 @@ 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 +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 17753fd3ea9..0feb154388e 100644 --- a/integration/test/Test/Brig.hs +++ b/integration/test/Test/Brig.hs @@ -1,15 +1,19 @@ module Test.Brig where +import API.Brig 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,104 @@ 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) + 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 "optSettings.setSftListAllServers" "enabled" + ) + } + ) + $ \domain -> do + user <- randomUser domain def + bindResponse (getCallsConfigV2 user) \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 + bindResponse (getCallsConfigV2 user) \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 + bindResponse (getCallsConfigV2 user) \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 + bindResponse (getCallsConfigV2 user) \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 + bindResponse (getCallsConfigV2 user) \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/libs/wire-api/src/Wire/API/Call/Config.hs b/libs/wire-api/src/Wire/API/Call/Config.hs index 18289ca1706..442f81fd4af 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, @@ -47,6 +48,15 @@ module Wire.API.Call.Config TurnHost (..), isHostName, + -- * SFTUsername + SFTUsername (SFTUsername), + mkSFTUsername, + suExpiresAt, + suVersion, + suKeyindex, + suShared, + suRandom, + -- * TurnUsername TurnUsername, turnUsername, @@ -61,6 +71,14 @@ module Wire.API.Call.Config sftServer, sftURL, + -- * AuthSFTServer + AuthSFTServer, + authSFTServer, + nauthSFTServer, + authURL, + authUsername, + authCredential, + -- * convenience isUdp, isTcp, @@ -106,7 +124,8 @@ data RTCConfiguration = RTCConfiguration { _rtcConfIceServers :: NonEmpty RTCIceServer, _rtcConfSftServers :: Maybe (NonEmpty SFTServer), _rtcConfTTL :: Word32, - _rtcConfSftServersAll :: Maybe [SFTServer] + _rtcConfSftServersAll :: Maybe [AuthSFTServer], + _rtcConfIsFederating :: Maybe Bool } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform RTCConfiguration) @@ -116,7 +135,8 @@ rtcConfiguration :: NonEmpty RTCIceServer -> Maybe (NonEmpty SFTServer) -> Word32 -> - Maybe [SFTServer] -> + Maybe [AuthSFTServer] -> + Maybe Bool -> RTCConfiguration rtcConfiguration = RTCConfiguration @@ -132,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 @@ -157,6 +179,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 +443,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 + _suShared :: 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, + _suShared = 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 $ _suShared 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 +641,7 @@ isTls uri = makeLenses ''RTCConfiguration makeLenses ''RTCIceServer makeLenses ''TurnURI +makeLenses ''SFTUsername makeLenses ''TurnUsername makeLenses ''SFTServer +makeLenses ''AuthSFTServer 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 1a1414c6204..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 @@ -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 = @@ -154,6 +123,7 @@ testObject_RTCConfiguration_user_1 = Nothing 2 Nothing + Nothing testObject_RTCConfiguration_user_2 :: RTCConfiguration testObject_RTCConfiguration_user_2 = @@ -332,6 +302,7 @@ testObject_RTCConfiguration_user_2 = ) 4 Nothing + Nothing testObject_RTCConfiguration_user_3 :: RTCConfiguration testObject_RTCConfiguration_user_3 = @@ -477,6 +448,7 @@ testObject_RTCConfiguration_user_3 = ) 9 Nothing + Nothing testObject_RTCConfiguration_user_4 :: RTCConfiguration testObject_RTCConfiguration_user_4 = @@ -672,6 +644,7 @@ testObject_RTCConfiguration_user_4 = ) 2 Nothing + Nothing testObject_RTCConfiguration_user_5 :: RTCConfiguration testObject_RTCConfiguration_user_5 = @@ -714,6 +687,7 @@ testObject_RTCConfiguration_user_5 = ) 2 Nothing + Nothing testObject_RTCConfiguration_user_6 :: RTCConfiguration testObject_RTCConfiguration_user_6 = @@ -736,6 +710,7 @@ testObject_RTCConfiguration_user_6 = Nothing 2 Nothing + Nothing testObject_RTCConfiguration_user_7 :: RTCConfiguration testObject_RTCConfiguration_user_7 = @@ -758,22 +733,50 @@ 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" ] ) + 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/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_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/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/brig.integration.yaml b/services/brig/brig.integration.yaml index a536c77626d..451e753ccac 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 +multiSFT: false + # 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/API/Public.hs b/services/brig/src/Brig/API/Public.hs index 0a4137e24b7..c72ee3d2db8 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -55,6 +55,7 @@ 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.UserPendingActivationStore (UserPendingActivationStore) import Brig.Options hiding (internalEvents, sesQueue) import Brig.Provider.API @@ -270,20 +271,22 @@ 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 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/App.hs b/services/brig/src/Brig/App.hs index b9f5a099cfc..6b3c39a3b4b 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, + enableSFTFederation, -- * 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, + _enableSFTFederation :: Maybe Bool } makeLenses ''Env @@ -248,7 +250,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") @@ -300,7 +302,8 @@ newEnv o = do _randomPrekeyLocalLock = prekeyLocalLock, _keyPackageLocalLock = kpLock, _rabbitmqChannel = rabbitChan, - _disabledVersions = allDisabledVersions + _disabledVersions = allDisabledVersions, + _enableSFTFederation = Opt.multiSFT o } where emailConn _ (Opt.EmailAWS aws) = pure (Just aws, Nothing) 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/Calling/API.hs b/services/brig/src/Brig/Calling/API.hs index 90998b1fb3a..998b92ee874 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,35 +49,37 @@ 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 +getCallsConfigV2 :: + ( Member (Embed IO) r, + Member SFT r + ) => + UserId -> + ConnId -> + Maybe (Range 1 10 Int) -> + (Handler r) Public.RTCConfiguration getCallsConfigV2 _ _ limit = do env <- view turnEnv staticUrl <- view $ settings . Opt.sftStaticUrl sftListAllServers <- fromMaybe Opt.HideAllSFTServers <$> view (settings . Opt.sftListAllServers) sftEnv' <- view sftEnv - logger <- view applog - manager <- view httpManager + sftFederation <- view enableSFTFederation discoveredServers <- turnServersV2 (env ^. turnServers) eitherConfig <- - liftIO - . runM @IO - . loggerToTinyLog logger - . interpretSFT manager + 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 @@ -91,18 +94,20 @@ 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 + ) => + 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 @@ -116,7 +121,7 @@ getCallsConfig _ _ = do data CallsConfigVersion = CallsConfigDeprecated - | CallsConfigV2 + | CallsConfigV2 (Maybe Bool) data NoTurnServers = NoTurnServers deriving (Show) @@ -129,7 +134,10 @@ 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 (Polysemy.Error NoTurnServers) r + ) => Calling.TurnEnv -> Discovery (NonEmpty Public.TurnURI) -> Maybe HttpsUrl -> @@ -139,7 +147,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 +157,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 +170,21 @@ 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 + let sftFederation' = case version of + CallsConfigDeprecated -> Nothing + CallsConfigV2 fed -> fed + + mSftServersAll <- + case version of + CallsConfigDeprecated -> pure Nothing + CallsConfigV2 _ -> + case (listAllServers, sftStaticUrl) of + (HideAllSFTServers, _) -> pure Nothing + (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 cTTL mSftServersAll + pure $ Public.rtcConfiguration srvs mSftServers (env ^. turnConfigTTL) mSftServersAll sftFederation' where limitedList :: NonEmpty Public.TurnURI -> Range 1 10 Int -> NonEmpty Public.TurnURI limitedList uris lim = @@ -182,10 +194,27 @@ 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.AuthSFTServer + authenticate = + maybe + (pure . Public.nauthSFTServer) + ( \SFTTokenEnv {..} sftsvr -> do + username <- liftIO $ genSFTUsername sftTokenTTL sftTokenPRNG + let credential = computeCred sftTokenSHA sftTokenSecret username + 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 9a77bbae6dc..b23a8c2a6dc 100644 --- a/services/brig/src/Brig/CanonicalInterpreter.hs +++ b/services/brig/src/Brig/CanonicalInterpreter.hs @@ -17,6 +17,7 @@ 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.UserPendingActivationStore (UserPendingActivationStore) import Brig.Effects.UserPendingActivationStore.Cassandra (userPendingActivationStoreToCassandra) import Brig.Options (ImplicitNoFederationRestriction (federationDomainConfig), federationDomainConfigs, federationStrategy) @@ -49,7 +50,8 @@ import Wire.Sem.Now.IO (nowToIOAction) import Wire.Sem.Paging.Cassandra (InternalPaging) type BrigCanonicalEffects = - '[ ConnectionStore InternalPaging, + '[ SFT, + ConnectionStore InternalPaging, Input UTCTime, Input (Local ()), NotificationSubsystem, @@ -110,6 +112,7 @@ runBrigToIO e (AppT ma) = do . runInputConst (toLocalUnsafe (e ^. settings . Opt.federationDomain) ()) . runInputSem (embed getCurrentTime) . connectionStoreToCassandra + . interpretSFT (e ^. httpManager) ) ) $ runReaderT ma e diff --git a/services/brig/src/Brig/Options.hs b/services/brig/src/Brig/Options.hs index 027e1a1ec3e..dca9d2b3a18 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, + -- | SFT Federation + multiSFT :: !(Maybe Bool), -- | RabbitMQ settings, required when federation is enabled. rabbitmq :: !(Maybe RabbitMqOpts), -- | AWS settings @@ -806,7 +808,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 +820,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 = @@ -886,7 +902,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 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 044c289f9d1..007a2041743 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 @@ -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 [] @@ -315,17 +316,18 @@ testSFTStaticV2NoStaticUrl = do <*> pure "foo.example.com" <*> pure 5 <*> pure (unsafeRange 1) + <*> pure Nothing turnUri <- generate arbitrary cfg <- runM @IO . ignoreLogs . interpretSFTInMemory mempty . throwErrorInIO @_ @NoTurnServers - $ 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 (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 () @@ -337,7 +339,7 @@ testSFTStaticV2StaticUrlError = do . ignoreLogs . interpretSFTInMemory mempty -- an empty lookup map, meaning there was an error . throwErrorInIO @_ @NoTurnServers - $ 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 @@ -354,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 + $ 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" - (Just servers) - (cfg ^. rtcConfSftServersAll) + ((^. sftURL) <$$> Just servers) + ((^. authURL) <$$> cfg ^. rtcConfSftServersAll) testSFTStaticV2ListAllServersDisabled :: IO () testSFTStaticV2ListAllServersDisabled = do @@ -374,7 +376,7 @@ testSFTStaticV2ListAllServersDisabled = do . ignoreLogs . interpretSFTInMemory (Map.singleton staticUrl (SFTGetResponse . Right $ servers)) . throwErrorInIO @_ @NoTurnServers - $ 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