diff --git a/changelog.d/5-internal/SQSERVICES-1559 b/changelog.d/5-internal/SQSERVICES-1559 new file mode 100644 index 0000000000..bbca6cfc2e --- /dev/null +++ b/changelog.d/5-internal/SQSERVICES-1559 @@ -0,0 +1 @@ +`AllFeatureConfigs` is now typed diff --git a/libs/wire-api/src/Wire/API/Team/Feature.hs b/libs/wire-api/src/Wire/API/Team/Feature.hs index f4b103099b..fc7caf05c5 100644 --- a/libs/wire-api/src/Wire/API/Team/Feature.hs +++ b/libs/wire-api/src/Wire/API/Team/Feature.hs @@ -62,8 +62,6 @@ module Wire.API.Team.Feature where import qualified Cassandra.CQL as Cass -import Control.Lens.Combinators (dimap) -import qualified Data.Aeson as Aeson import qualified Data.Attoparsec.ByteString as Parser import Data.ByteString.Conversion (FromByteString (..), ToByteString (..), fromByteString, toByteString') import Data.Domain (Domain) @@ -85,7 +83,7 @@ import Wire.API.Arbitrary (Arbitrary, GenericUniform (..)) ---------------------------------------------------------------------- -- TeamFeatureName --- | If you add a constructor here, you need extend multiple defintions, which +-- | If you add a constructor here, you need extend multiple definitions, which -- aren't checked by GHC. -- -- Follow this Checklist: @@ -102,9 +100,8 @@ import Wire.API.Arbitrary (Arbitrary, GenericUniform (..)) -- * Update the Arbitrary instance of FeatureFlags -- in libs/galley-types/test/unit/Test/Galley/Types.hs -- * roleHiddenPermissions ChangeTeamFeature and ViewTeamFeature --- * services/galley/src/Galley/API/Teams/Features.hs --- * maybe extend getAllFeatureConfigs (if feature status is user-visibile) --- * maybe extend getAllFeatures (if feature status is user-visibile) +-- * add the feature status to `AllFeatureConfigs` (see below) +-- * follow the type errors and fix them (e.g. in services/galley/src/Galley/API/Teams/Features.hs) -- * services/galley/schema/src/ -- * add a migration like the one in "V43_TeamFeatureDigitalSignatures.hs" -- * services/galley/test/integration/API/Teams/Feature.hs @@ -362,6 +359,59 @@ modelForTeamFeature TeamFeatureGuestLinks = modelTeamFeatureStatusNoConfig modelForTeamFeature TeamFeatureSndFactorPasswordChallenge = modelTeamFeatureStatusNoConfig modelForTeamFeature TeamFeatureSearchVisibilityInbound = modelTeamFeatureStatusNoConfig +data AllFeatureConfigs = AllFeatureConfigs + { afcLegalholdStatusInternal :: TeamFeatureStatus 'WithoutLockStatus 'TeamFeatureLegalHold, + afcSSOStatusInternal :: TeamFeatureStatus 'WithoutLockStatus 'TeamFeatureSSO, + afcTeamSearchVisibilityAvailableInternal :: TeamFeatureStatus 'WithoutLockStatus 'TeamFeatureSearchVisibility, + afcValidateSAMLEmailsInternal :: TeamFeatureStatus 'WithoutLockStatus 'TeamFeatureValidateSAMLEmails, + afcDigitalSignaturesInternal :: TeamFeatureStatus 'WithoutLockStatus 'TeamFeatureDigitalSignatures, + afcAppLockInternal :: TeamFeatureStatus 'WithoutLockStatus 'TeamFeatureAppLock, + afcFileSharingInternal :: TeamFeatureStatus 'WithLockStatus 'TeamFeatureFileSharing, + afcClassifiedDomainsInternal :: TeamFeatureStatus 'WithoutLockStatus 'TeamFeatureClassifiedDomains, + afcConferenceCallingInternal :: TeamFeatureStatus 'WithoutLockStatus 'TeamFeatureConferenceCalling, + afcSelfDeletingMessagesInternal :: TeamFeatureStatus 'WithLockStatus 'TeamFeatureSelfDeletingMessages, + afcGuestLinkInternal :: TeamFeatureStatus 'WithLockStatus 'TeamFeatureGuestLinks, + afcSndFactorPasswordChallengeInternal :: TeamFeatureStatus 'WithLockStatus 'TeamFeatureSndFactorPasswordChallenge + } + deriving stock (Eq, Show) + deriving (FromJSON, ToJSON, S.ToSchema) via (Schema AllFeatureConfigs) + +instance ToSchema AllFeatureConfigs where + schema = + object "AllFeatureConfigs" $ + AllFeatureConfigs + <$> afcLegalholdStatusInternal .= field (name @'TeamFeatureLegalHold) schema + <*> afcSSOStatusInternal .= field (name @'TeamFeatureSSO) schema + <*> afcTeamSearchVisibilityAvailableInternal .= field (name @'TeamFeatureSearchVisibility) schema + <*> afcValidateSAMLEmailsInternal .= field (name @'TeamFeatureValidateSAMLEmails) schema + <*> afcDigitalSignaturesInternal .= field (name @'TeamFeatureDigitalSignatures) schema + <*> afcAppLockInternal .= field (name @'TeamFeatureAppLock) schema + <*> afcFileSharingInternal .= field (name @'TeamFeatureFileSharing) schema + <*> afcClassifiedDomainsInternal .= field (name @'TeamFeatureClassifiedDomains) schema + <*> afcConferenceCallingInternal .= field (name @'TeamFeatureConferenceCalling) schema + <*> afcSelfDeletingMessagesInternal .= field (name @'TeamFeatureSelfDeletingMessages) schema + <*> afcGuestLinkInternal .= field (name @'TeamFeatureGuestLinks) schema + <*> afcSndFactorPasswordChallengeInternal .= field (name @'TeamFeatureSndFactorPasswordChallenge) schema + where + name :: forall a. KnownTeamFeatureName a => Text + name = cs (toByteString' (knownTeamFeatureName @a)) + +instance Arbitrary AllFeatureConfigs where + arbitrary = + AllFeatureConfigs + <$> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + ---------------------------------------------------------------------- -- TeamFeatureStatusNoConfig @@ -665,12 +715,3 @@ data LowerCaseFirst instance StringModifier LowerCaseFirst where getStringModifier (x : xs) = toLower x : xs getStringModifier [] = [] - -newtype AllFeatureConfigs = AllFeatureConfigs {_allFeatureConfigs :: Aeson.Object} - deriving stock (Eq, Show) - deriving (FromJSON, ToJSON, S.ToSchema) via (Schema AllFeatureConfigs) - -instance ToSchema AllFeatureConfigs where - schema = - named "AllFeatureConfigs" $ - dimap _allFeatureConfigs AllFeatureConfigs jsonObject diff --git a/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs b/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs index 6c125124df..051555807f 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs @@ -201,6 +201,7 @@ tests = testRoundTrip @(Team.Feature.TeamFeatureStatus 'Team.Feature.WithLockStatus 'Team.Feature.TeamFeatureSelfDeletingMessages), testRoundTrip @(Team.Feature.TeamFeatureStatus 'Team.Feature.WithoutLockStatus 'Team.Feature.TeamFeatureSelfDeletingMessages), testRoundTrip @(Team.Feature.TeamFeatureStatus 'Team.Feature.WithoutLockStatus 'Team.Feature.TeamFeatureSearchVisibilityInbound), + testRoundTrip @Team.Feature.AllFeatureConfigs, testRoundTrip @Team.Feature.TeamFeatureStatusValue, testRoundTrip @Team.Feature.LockStatusValue, testRoundTrip @Team.Feature.LockStatus, diff --git a/services/galley/src/Galley/API/Public/Servant.hs b/services/galley/src/Galley/API/Public/Servant.hs index c98c887cd8..24b47ed5f0 100644 --- a/services/galley/src/Galley/API/Public/Servant.hs +++ b/services/galley/src/Galley/API/Public/Servant.hs @@ -228,8 +228,8 @@ servantSitemap = setSndFactorPasswordChallengeInternal . DoAuth ) - <@> mkNamedAPI @"get-all-feature-configs" getAllFeatureConfigs - <@> mkNamedAPI @"get-all-features" (\luid tid -> AllFeatureConfigs <$> getAllFeatures luid tid) + <@> mkNamedAPI @"get-all-feature-configs" getAllFeatureConfigsForUser + <@> mkNamedAPI @"get-all-features" getAllFeatureConfigsForTeam <@> mkNamedAPI @'("get-config", 'TeamFeatureLegalHold) ( getFeatureConfig @'WithoutLockStatus @'TeamFeatureLegalHold getLegalholdStatusInternal diff --git a/services/galley/src/Galley/API/Teams/Features.hs b/services/galley/src/Galley/API/Teams/Features.hs index c8acdc510b..bcec1dd29c 100644 --- a/services/galley/src/Galley/API/Teams/Features.hs +++ b/services/galley/src/Galley/API/Teams/Features.hs @@ -21,8 +21,8 @@ module Galley.API.Teams.Features getFeatureStatusNoConfig, setFeatureStatus, getFeatureConfig, - getAllFeatureConfigs, - getAllFeatures, + getAllFeatureConfigsForUser, + getAllFeatureConfigsForTeam, getSSOStatusInternal, setSSOStatusInternal, getLegalholdStatusInternal, @@ -54,17 +54,13 @@ module Galley.API.Teams.Features DoAuth (..), FeatureGetter, FeatureSetter, - GetFeatureInternalParam, + FeatureScope, guardSecondFactorDisabled, ) where import Control.Lens -import qualified Data.Aeson as Aeson -import qualified Data.Aeson.Key as AesonKey -import qualified Data.Aeson.KeyMap as KeyMap import Data.ByteString.Conversion hiding (fromList) -import Data.Either.Extra (eitherToMaybe) import Data.Id import Data.Proxy (Proxy (Proxy)) import Data.Qualified @@ -106,7 +102,12 @@ import Wire.API.Team.Feature data DoAuth = DoAuth UserId | DontDoAuth -type FeatureGetter l f r = Tagged '(l, f) (GetFeatureInternalParam -> Sem r (TeamFeatureStatus l f)) +data FeatureScope + = FeatureScopeServer + | FeatureScopeTeam TeamId + | FeatureScopeUser UserId + +type FeatureGetter l f r = Tagged '(l, f) (FeatureScope -> Sem r (TeamFeatureStatus l f)) type FeatureSetter f r = Tagged @@ -140,7 +141,7 @@ getFeatureStatus (Tagged getter) doauth tid = do void $ permissionCheck ViewTeamFeature zusrMembership DontDoAuth -> assertTeamExists tid - getter (Right tid) + getter (FeatureScopeTeam tid) -- | For team-settings, like 'getFeatureStatus'. setFeatureStatus :: @@ -208,14 +209,16 @@ getFeatureConfig :: getFeatureConfig (Tagged getter) zusr = do mbTeam <- getOneUserTeam zusr case mbTeam of - Nothing -> getter (Left (Just zusr)) + Nothing -> getter (FeatureScopeUser zusr) Just tid -> do zusrMembership <- getTeamMember tid zusr void $ permissionCheck ViewTeamFeature zusrMembership assertTeamExists tid - getter (Right tid) + getter (FeatureScopeTeam tid) -getAllFeatureConfigs :: +-- | Get feature config for a user. If the user is a member of a team and has the required permissions, this will return the team's feature configs. +-- If the user is not a member of a team, this will return the personal feature configs (the server defaults). +getAllFeatureConfigsForUser :: Members '[ BrigAccess, ErrorS 'NotATeamMember, @@ -228,41 +231,16 @@ getAllFeatureConfigs :: r => UserId -> Sem r AllFeatureConfigs -getAllFeatureConfigs zusr = do +getAllFeatureConfigsForUser zusr = do mbTeam <- getOneUserTeam zusr - zusrMembership <- maybe (pure Nothing) (flip getTeamMember zusr) mbTeam - let getStatus :: - forall (ps :: IncludeLockStatus) (a :: TeamFeatureName) r. - ( KnownTeamFeatureName a, - Aeson.ToJSON (TeamFeatureStatus ps a), - Members '[ErrorS 'NotATeamMember, ErrorS OperationDenied, TeamStore] r - ) => - FeatureGetter ps a r -> - Sem r (Aeson.Key, Aeson.Value) - getStatus (Tagged getter) = do - when (isJust mbTeam) $ do - void $ permissionCheck ViewTeamFeature zusrMembership - status <- getter (maybe (Left (Just zusr)) Right mbTeam) - let feature = knownTeamFeatureName @a - pure $ AesonKey.fromText (cs (toByteString' feature)) Aeson..= status - - AllFeatureConfigs . KeyMap.fromList - <$> sequence - [ getStatus @'WithoutLockStatus @'TeamFeatureLegalHold getLegalholdStatusInternal, - getStatus @'WithoutLockStatus @'TeamFeatureSSO getSSOStatusInternal, - getStatus @'WithoutLockStatus @'TeamFeatureSearchVisibility getTeamSearchVisibilityAvailableInternal, - getStatus @'WithoutLockStatus @'TeamFeatureValidateSAMLEmails getValidateSAMLEmailsInternal, - getStatus @'WithoutLockStatus @'TeamFeatureDigitalSignatures getDigitalSignaturesInternal, - getStatus @'WithoutLockStatus @'TeamFeatureAppLock getAppLockInternal, - getStatus @'WithLockStatus @'TeamFeatureFileSharing getFileSharingInternal, - getStatus @'WithoutLockStatus @'TeamFeatureClassifiedDomains getClassifiedDomainsInternal, - getStatus @'WithoutLockStatus @'TeamFeatureConferenceCalling getConferenceCallingInternal, - getStatus @'WithLockStatus @'TeamFeatureSelfDeletingMessages getSelfDeletingMessagesInternal, - getStatus @'WithLockStatus @'TeamFeatureGuestLinks getGuestLinkInternal, - getStatus @'WithLockStatus @'TeamFeatureSndFactorPasswordChallenge getSndFactorPasswordChallengeInternal - ] - -getAllFeatures :: + when (isJust mbTeam) $ do + zusrMembership <- maybe (pure Nothing) (`getTeamMember` zusr) mbTeam + void $ permissionCheck ViewTeamFeature zusrMembership + let scope = maybe (FeatureScopeUser zusr) FeatureScopeTeam mbTeam + getAllFeatureConfigsInternal scope + +-- | Get feature configs for a team. User must be a member of the team and have permission to view team features. +getAllFeatureConfigsForTeam :: forall r. Members '[ BrigAccess, @@ -277,35 +255,39 @@ getAllFeatures :: r => Local UserId -> TeamId -> - Sem r Aeson.Object -getAllFeatures luid tid = do - KeyMap.fromList - <$> sequence - [ getStatus @'WithoutLockStatus @'TeamFeatureSSO getSSOStatusInternal, - getStatus @'WithoutLockStatus @'TeamFeatureLegalHold getLegalholdStatusInternal, - getStatus @'WithoutLockStatus @'TeamFeatureSearchVisibility getTeamSearchVisibilityAvailableInternal, - getStatus @'WithoutLockStatus @'TeamFeatureValidateSAMLEmails getValidateSAMLEmailsInternal, - getStatus @'WithoutLockStatus @'TeamFeatureDigitalSignatures getDigitalSignaturesInternal, - getStatus @'WithoutLockStatus @'TeamFeatureAppLock getAppLockInternal, - getStatus @'WithLockStatus @'TeamFeatureFileSharing getFileSharingInternal, - getStatus @'WithoutLockStatus @'TeamFeatureClassifiedDomains getClassifiedDomainsInternal, - getStatus @'WithoutLockStatus @'TeamFeatureConferenceCalling getConferenceCallingInternal, - getStatus @'WithLockStatus @'TeamFeatureSelfDeletingMessages getSelfDeletingMessagesInternal, - getStatus @'WithLockStatus @'TeamFeatureGuestLinks getGuestLinkInternal, - getStatus @'WithLockStatus @'TeamFeatureSndFactorPasswordChallenge getSndFactorPasswordChallengeInternal - ] - where - getStatus :: - forall (ps :: IncludeLockStatus) (a :: TeamFeatureName). - ( KnownTeamFeatureName a, - Aeson.ToJSON (TeamFeatureStatus ps a) - ) => - FeatureGetter ps a r -> - Sem r (Aeson.Key, Aeson.Value) - getStatus getter = do - status <- getFeatureStatus @ps @a getter (DoAuth (tUnqualified luid)) tid - let feature = knownTeamFeatureName @a - pure $ AesonKey.fromText (cs (toByteString' feature)) Aeson..= status + Sem r AllFeatureConfigs +getAllFeatureConfigsForTeam luid tid = do + zusrMembership <- getTeamMember tid (tUnqualified luid) + void $ permissionCheck ViewTeamFeature zusrMembership + getAllFeatureConfigsInternal (FeatureScopeTeam tid) + +getAllFeatureConfigsInternal :: + Members + '[ BrigAccess, + ErrorS 'NotATeamMember, + ErrorS OperationDenied, + Input Opts, + LegalHoldStore, + TeamFeatureStore, + TeamStore + ] + r => + FeatureScope -> + Sem r AllFeatureConfigs +getAllFeatureConfigsInternal byUserOrTeam = + AllFeatureConfigs + <$> unTagged getLegalholdStatusInternal byUserOrTeam + <*> unTagged getSSOStatusInternal byUserOrTeam + <*> unTagged getTeamSearchVisibilityAvailableInternal byUserOrTeam + <*> unTagged getValidateSAMLEmailsInternal byUserOrTeam + <*> unTagged getDigitalSignaturesInternal byUserOrTeam + <*> unTagged getAppLockInternal byUserOrTeam + <*> unTagged getFileSharingInternal byUserOrTeam + <*> unTagged getClassifiedDomainsInternal byUserOrTeam + <*> unTagged getConferenceCallingInternal byUserOrTeam + <*> unTagged getSelfDeletingMessagesInternal byUserOrTeam + <*> unTagged getGuestLinkInternal byUserOrTeam + <*> unTagged getSndFactorPasswordChallengeInternal byUserOrTeam getFeatureStatusNoConfig :: forall (a :: TeamFeatureName) r. @@ -336,18 +318,15 @@ setFeatureStatusNoConfig applyState = Tagged $ \tid status -> do Event.Event Event.Update (knownTeamFeatureName @a) (EdFeatureWithoutConfigChanged newStatus) pure newStatus --- | FUTUREWORK(fisx): (thanks pcapriotti) this should probably be a type family dependent on --- the feature flag, so that we get more type safety. -type GetFeatureInternalParam = Either (Maybe UserId) TeamId - getSSOStatusInternal :: Members '[Input Opts, TeamFeatureStore] r => FeatureGetter 'WithoutLockStatus 'TeamFeatureSSO r getSSOStatusInternal = - Tagged $ - either - (const $ TeamFeatureStatusNoConfig <$> getDef) - (getFeatureStatusNoConfig @'TeamFeatureSSO getDef) + Tagged $ \case + FeatureScopeTeam tid -> + getFeatureStatusNoConfig @'TeamFeatureSSO getDef tid + FeatureScopeUser _ -> TeamFeatureStatusNoConfig <$> getDef + FeatureScopeServer -> TeamFeatureStatusNoConfig <$> getDef where getDef :: Member (Input Opts) r => Sem r TeamFeatureStatusValue getDef = @@ -366,10 +345,10 @@ getTeamSearchVisibilityAvailableInternal :: Members '[Input Opts, TeamFeatureStore] r => FeatureGetter 'WithoutLockStatus 'TeamFeatureSearchVisibility r getTeamSearchVisibilityAvailableInternal = - Tagged $ - either - (const $ TeamFeatureStatusNoConfig <$> getDef) - (getFeatureStatusNoConfig @'TeamFeatureSearchVisibility getDef) + Tagged $ \case + FeatureScopeTeam tid -> getFeatureStatusNoConfig @'TeamFeatureSearchVisibility getDef tid + FeatureScopeUser _ -> TeamFeatureStatusNoConfig <$> getDef + FeatureScopeServer -> TeamFeatureStatusNoConfig <$> getDef where getDef = do inputs (view (optSettings . setFeatureFlags . flagTeamSearchVisibility)) <&> \case @@ -390,10 +369,12 @@ getValidateSAMLEmailsInternal :: ) => FeatureGetter 'WithoutLockStatus 'TeamFeatureValidateSAMLEmails r getValidateSAMLEmailsInternal = - Tagged $ - getFeatureStatusWithDefaultConfig @'TeamFeatureValidateSAMLEmails - flagsTeamFeatureValidateSAMLEmailsStatus - . eitherToMaybe + Tagged $ getFeatureStatusWithDefaultConfig @'TeamFeatureValidateSAMLEmails flagsTeamFeatureValidateSAMLEmailsStatus . mbTeam + where + mbTeam = \case + FeatureScopeTeam tid -> Just tid + FeatureScopeUser _ -> Nothing + FeatureScopeServer -> Nothing setValidateSAMLEmailsInternal :: Members '[GundeckAccess, TeamFeatureStore, TeamStore, P.TinyLog] r => @@ -404,10 +385,10 @@ getDigitalSignaturesInternal :: Member TeamFeatureStore r => FeatureGetter 'WithoutLockStatus 'TeamFeatureDigitalSignatures r getDigitalSignaturesInternal = - Tagged $ - either - (const $ TeamFeatureStatusNoConfig <$> getDef) - (getFeatureStatusNoConfig @'TeamFeatureDigitalSignatures getDef) + Tagged $ \case + FeatureScopeTeam tid -> getFeatureStatusNoConfig @'TeamFeatureDigitalSignatures getDef tid + FeatureScopeUser _ -> TeamFeatureStatusNoConfig <$> getDef + FeatureScopeServer -> TeamFeatureStatusNoConfig <$> getDef where -- FUTUREWORK: we may also want to get a default from the server config file here, like for -- sso, and team search visibility. @@ -423,11 +404,12 @@ getLegalholdStatusInternal :: Members '[LegalHoldStore, TeamFeatureStore, TeamStore] r => FeatureGetter 'WithoutLockStatus 'TeamFeatureLegalHold r getLegalholdStatusInternal = Tagged $ \case - (Left _) -> pure $ TeamFeatureStatusNoConfig TeamFeatureDisabled - (Right tid) -> do + FeatureScopeTeam tid -> do isLegalHoldEnabledForTeam tid <&> \case True -> TeamFeatureStatusNoConfig TeamFeatureEnabled False -> TeamFeatureStatusNoConfig TeamFeatureDisabled + FeatureScopeUser _ -> pure $ TeamFeatureStatusNoConfig TeamFeatureDisabled + FeatureScopeServer -> pure $ TeamFeatureStatusNoConfig TeamFeatureDisabled setLegalholdStatusInternal :: forall p r. @@ -493,11 +475,12 @@ getFileSharingInternal :: ) => FeatureGetter 'WithLockStatus 'TeamFeatureFileSharing r getFileSharingInternal = Tagged $ \case - Left _ -> getCfgDefault - Right tid -> do + FeatureScopeTeam tid -> do cfgDefault <- getCfgDefault (mbFeatureStatus, fromMaybe (tfwoapsLockStatus cfgDefault) -> lockStatus) <- TeamFeatures.getFeatureStatusNoConfigAndLockStatus @'TeamFeatureFileSharing tid pure $ determineFeatureStatus cfgDefault lockStatus mbFeatureStatus + FeatureScopeUser _ -> getCfgDefault + FeatureScopeServer -> getCfgDefault where getCfgDefault :: Sem r (TeamFeatureStatus 'WithLockStatus 'TeamFeatureFileSharing) getCfgDefault = input <&> view (optSettings . setFeatureFlags . flagFileSharing . unDefaults) @@ -563,11 +546,16 @@ setFileSharingInternal = Tagged $ \tid status -> do getAppLockInternal :: Members '[Input Opts, TeamFeatureStore] r => FeatureGetter 'WithoutLockStatus 'TeamFeatureAppLock r -getAppLockInternal = Tagged $ \mbtid -> do - Defaults defaultStatus <- inputs (view (optSettings . setFeatureFlags . flagAppLockDefaults)) - status <- - join <$> (TeamFeatures.getApplockFeatureStatus `mapM` either (const Nothing) Just mbtid) - pure $ fromMaybe defaultStatus status +getAppLockInternal = Tagged $ \case + FeatureScopeTeam tid -> do + cfgDefault <- getCfgDefault + mStatus <- TeamFeatures.getApplockFeatureStatus tid + pure $ fromMaybe cfgDefault mStatus + FeatureScopeUser _ -> getCfgDefault + FeatureScopeServer -> getCfgDefault + where + getCfgDefault = do + inputs (view (optSettings . setFeatureFlags . flagAppLockDefaults . unDefaults)) setAppLockInternal :: Members '[GundeckAccess, TeamFeatureStore, TeamStore, Error TeamFeatureError, P.TinyLog] r => @@ -594,11 +582,9 @@ getConferenceCallingInternal :: Members '[BrigAccess, Input Opts, TeamFeatureStore] r => FeatureGetter 'WithoutLockStatus 'TeamFeatureConferenceCalling r getConferenceCallingInternal = Tagged $ \case - (Left (Just uid)) -> getFeatureConfigViaAccount @'TeamFeatureConferenceCalling uid - (Left Nothing) -> - getFeatureStatusWithDefaultConfig @'TeamFeatureConferenceCalling flagConferenceCalling Nothing - (Right tid) -> - getFeatureStatusWithDefaultConfig @'TeamFeatureConferenceCalling flagConferenceCalling (Just tid) + FeatureScopeTeam tid -> getFeatureStatusWithDefaultConfig @'TeamFeatureConferenceCalling flagConferenceCalling (Just tid) + FeatureScopeUser uid -> getFeatureConfigViaAccount @'TeamFeatureConferenceCalling uid + FeatureScopeServer -> getFeatureStatusWithDefaultConfig @'TeamFeatureConferenceCalling flagConferenceCalling Nothing setConferenceCallingInternal :: Members '[GundeckAccess, TeamFeatureStore, TeamStore, P.TinyLog] r => @@ -613,8 +599,7 @@ getSelfDeletingMessagesInternal :: ) => FeatureGetter 'WithLockStatus 'TeamFeatureSelfDeletingMessages r getSelfDeletingMessagesInternal = Tagged $ \case - Left _ -> getCfgDefault - Right tid -> do + FeatureScopeTeam tid -> do cfgDefault <- getCfgDefault let defLockStatus = tfwcapsLockStatus cfgDefault (mbFeatureStatus, fromMaybe defLockStatus -> lockStatus) <- TeamFeatures.getSelfDeletingMessagesStatus tid @@ -626,6 +611,8 @@ getSelfDeletingMessagesInternal = Tagged $ \case Unlocked (Unlocked, Nothing) -> cfgDefault {tfwcapsLockStatus = Unlocked} (Locked, _) -> cfgDefault {tfwcapsLockStatus = Locked} + FeatureScopeUser _ -> getCfgDefault + FeatureScopeServer -> getCfgDefault where getCfgDefault :: Sem r (TeamFeatureStatusWithConfigAndLockStatus TeamFeatureSelfDeletingMessagesConfig) getCfgDefault = input <&> view (optSettings . setFeatureFlags . flagSelfDeletingMessages . unDefaults) @@ -655,11 +642,12 @@ getGuestLinkInternal :: (Member (Input Opts) r, Member TeamFeatureStore r) => FeatureGetter 'WithLockStatus 'TeamFeatureGuestLinks r getGuestLinkInternal = Tagged $ \case - Left _ -> getCfgDefault - Right tid -> do + FeatureScopeTeam tid -> do cfgDefault <- getCfgDefault (mbFeatureStatus, fromMaybe (tfwoapsLockStatus cfgDefault) -> lockStatus) <- TeamFeatures.getFeatureStatusNoConfigAndLockStatus @'TeamFeatureGuestLinks tid pure $ determineFeatureStatus cfgDefault lockStatus mbFeatureStatus + FeatureScopeUser _ -> getCfgDefault + FeatureScopeServer -> getCfgDefault where getCfgDefault :: Sem r (TeamFeatureStatus 'WithLockStatus 'TeamFeatureGuestLinks) getCfgDefault = input <&> view (optSettings . setFeatureFlags . flagConversationGuestLinks . unDefaults) @@ -694,11 +682,12 @@ getSndFactorPasswordChallengeInternal :: (Member (Input Opts) r, Member TeamFeatureStore r) => FeatureGetter 'WithLockStatus 'TeamFeatureSndFactorPasswordChallenge r getSndFactorPasswordChallengeInternal = Tagged $ \case - Left _ -> getCfgDefault - Right tid -> do + FeatureScopeTeam tid -> do cfgDefault <- getCfgDefault (mbFeatureStatus, fromMaybe (tfwoapsLockStatus cfgDefault) -> lockStatus) <- TeamFeatures.getFeatureStatusNoConfigAndLockStatus @'TeamFeatureSndFactorPasswordChallenge tid pure $ determineFeatureStatus cfgDefault lockStatus mbFeatureStatus + FeatureScopeUser _ -> getCfgDefault + FeatureScopeServer -> getCfgDefault where getCfgDefault :: Sem r (TeamFeatureStatus 'WithLockStatus 'TeamFeatureSndFactorPasswordChallenge) getCfgDefault = input <&> view (optSettings . setFeatureFlags . flagTeamFeatureSndFactorPasswordChallengeStatus . unDefaults) @@ -713,21 +702,21 @@ getSndFactorPasswordChallengeNoAuth :: Maybe UserId -> Sem r TeamFeatureStatusNoConfig getSndFactorPasswordChallengeNoAuth mbUserId = do - byUserOrTeamParam <- getParam mbUserId - TeamFeatureStatusNoConfig . tfwoapsStatus <$> unTagged getSndFactorPasswordChallengeInternal byUserOrTeamParam + scope <- getScope mbUserId + TeamFeatureStatusNoConfig . tfwoapsStatus <$> unTagged getSndFactorPasswordChallengeInternal scope where - getParam :: Maybe UserId -> Sem r GetFeatureInternalParam - getParam = \case + getScope :: Maybe UserId -> Sem r FeatureScope + getScope = \case Just uid -> do mbTeam <- getOneUserTeam uid case mbTeam of - Nothing -> pure (Left (Just uid)) + Nothing -> pure $ FeatureScopeUser uid Just tid -> do teamExists <- isJust <$> getTeam tid if teamExists - then pure (Right tid) - else pure (Left (Just uid)) - Nothing -> pure (Left Nothing) + then pure $ FeatureScopeTeam tid + else pure $ FeatureScopeUser uid + Nothing -> pure FeatureScopeServer -- | If second factor auth is enabled, make sure that end-points that don't support it, but should, are blocked completely. (This is a workaround until we have 2FA for those end-points as well.) -- @@ -754,7 +743,7 @@ guardSecondFactorDisabled uid cid action = do Just tid -> do teamExists <- isJust <$> getTeam tid if teamExists - then TeamFeatureStatusNoConfig . tfwoapsStatus <$> unTagged getSndFactorPasswordChallengeInternal (Right tid) + then TeamFeatureStatusNoConfig . tfwoapsStatus <$> unTagged getSndFactorPasswordChallengeInternal (FeatureScopeTeam tid) else getSndFactorPasswordChallengeNoAuth (Just uid) case tfwoStatus teamFeature of TeamFeatureDisabled -> action @@ -789,10 +778,10 @@ getTeamSearchVisibilityInboundInternal :: Members '[Input Opts, TeamFeatureStore] r => FeatureGetter 'WithoutLockStatus 'TeamFeatureSearchVisibilityInbound r getTeamSearchVisibilityInboundInternal = - Tagged $ - either - (const $ getFeatureStatusWithDefaultConfig @'TeamFeatureSearchVisibilityInbound flagTeamFeatureSearchVisibilityInbound Nothing) - (getFeatureStatusWithDefaultConfig @'TeamFeatureSearchVisibilityInbound flagTeamFeatureSearchVisibilityInbound . Just) + Tagged $ \case + FeatureScopeTeam tid -> getFeatureStatusWithDefaultConfig @'TeamFeatureSearchVisibilityInbound flagTeamFeatureSearchVisibilityInbound (Just tid) + FeatureScopeUser _ -> getFeatureStatusWithDefaultConfig @'TeamFeatureSearchVisibilityInbound flagTeamFeatureSearchVisibilityInbound Nothing + FeatureScopeServer -> getFeatureStatusWithDefaultConfig @'TeamFeatureSearchVisibilityInbound flagTeamFeatureSearchVisibilityInbound Nothing setTeamSearchVisibilityInboundInternal :: Members '[Error InternalError, GundeckAccess, TeamStore, TeamFeatureStore, BrigAccess, P.TinyLog] r =>