diff --git a/changelog.d/1-api-changes/get-feature-config-seld-del-msgs-with-payment-status b/changelog.d/1-api-changes/get-feature-config-seld-del-msgs-with-payment-status new file mode 100644 index 0000000000..28b3679e34 --- /dev/null +++ b/changelog.d/1-api-changes/get-feature-config-seld-del-msgs-with-payment-status @@ -0,0 +1 @@ +get team feature config for self deleting messages response includes payment status diff --git a/changelog.d/1-api-changes/set-payment-status-self-del-msgs b/changelog.d/1-api-changes/set-payment-status-self-del-msgs new file mode 100644 index 0000000000..89029f4ca4 --- /dev/null +++ b/changelog.d/1-api-changes/set-payment-status-self-del-msgs @@ -0,0 +1 @@ +new internal endpoints for setting the payment status of self deleting messages diff --git a/changelog.d/2-features/set-payment-status-for-self-del-msgs b/changelog.d/2-features/set-payment-status-for-self-del-msgs new file mode 100644 index 0000000000..6798a7b24d --- /dev/null +++ b/changelog.d/2-features/set-payment-status-for-self-del-msgs @@ -0,0 +1 @@ +payment status for the self deleting messages feature can be set internally by ibis and customer support diff --git a/docs/reference/cassandra-schema.cql b/docs/reference/cassandra-schema.cql index 7b70e2f464..ec307eb446 100644 --- a/docs/reference/cassandra-schema.cql +++ b/docs/reference/cassandra-schema.cql @@ -422,6 +422,7 @@ CREATE TABLE galley_test.team_features ( file_sharing int, legalhold_status int, search_visibility_status int, + self_deleting_messages_payment_status int, self_deleting_messages_status int, self_deleting_messages_ttl int, sso_status int, diff --git a/libs/galley-types/src/Galley/Types/Teams.hs b/libs/galley-types/src/Galley/Types/Teams.hs index 8e727e90a1..3dda8cc73d 100644 --- a/libs/galley-types/src/Galley/Types/Teams.hs +++ b/libs/galley-types/src/Galley/Types/Teams.hs @@ -212,11 +212,11 @@ data FeatureFlags = FeatureFlags { _flagSSO :: !FeatureSSO, _flagLegalHold :: !FeatureLegalHold, _flagTeamSearchVisibility :: !FeatureTeamSearchVisibility, - _flagAppLockDefaults :: !(Defaults (TeamFeatureStatus 'TeamFeatureAppLock)), - _flagClassifiedDomains :: !(TeamFeatureStatus 'TeamFeatureClassifiedDomains), - _flagFileSharing :: !(Defaults (TeamFeatureStatus 'TeamFeatureFileSharing)), - _flagConferenceCalling :: !(Defaults (TeamFeatureStatus 'TeamFeatureConferenceCalling)), - _flagSelfDeletingMessages :: !(Defaults (TeamFeatureStatus 'TeamFeatureSelfDeletingMessages)) + _flagAppLockDefaults :: !(Defaults (TeamFeatureStatus 'WithoutPaymentStatus 'TeamFeatureAppLock)), + _flagClassifiedDomains :: !(TeamFeatureStatus 'WithoutPaymentStatus 'TeamFeatureClassifiedDomains), + _flagFileSharing :: !(Defaults (TeamFeatureStatus 'WithoutPaymentStatus 'TeamFeatureFileSharing)), + _flagConferenceCalling :: !(Defaults (TeamFeatureStatus 'WithPaymentStatus 'TeamFeatureConferenceCalling)), + _flagSelfDeletingMessages :: !(Defaults (TeamFeatureStatus 'WithPaymentStatus 'TeamFeatureSelfDeletingMessages)) } deriving (Eq, Show, Generic) @@ -261,7 +261,7 @@ instance FromJSON FeatureFlags where <*> (fromMaybe (Defaults defaultAppLockStatus) <$> (obj .:? "appLock")) <*> (fromMaybe defaultClassifiedDomains <$> (obj .:? "classifiedDomains")) <*> (fromMaybe (Defaults (TeamFeatureStatusNoConfig TeamFeatureEnabled)) <$> (obj .:? "fileSharing")) - <*> (fromMaybe (Defaults (TeamFeatureStatusNoConfig TeamFeatureEnabled)) <$> (obj .:? "conferenceCalling")) + <*> (fromMaybe (Defaults defaultConferenceCalling) <$> (obj .:? "conferenceCalling")) <*> (fromMaybe (Defaults defaultSelfDeletingMessagesStatus) <$> (obj .:? "selfDeletingMessages")) instance ToJSON FeatureFlags where diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs index 51e34b18d4..340e6842ac 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs @@ -66,7 +66,7 @@ type GetAccountFeatureConfig = :> Capture "uid" UserId :> "features" :> "conferenceCalling" - :> Get '[Servant.JSON] (ApiFt.TeamFeatureStatus 'ApiFt.TeamFeatureConferenceCalling) + :> Get '[Servant.JSON] (ApiFt.TeamFeatureStatus 'ApiFt.WithoutPaymentStatus 'ApiFt.TeamFeatureConferenceCalling) type PutAccountFeatureConfig = Summary @@ -75,7 +75,7 @@ type PutAccountFeatureConfig = :> Capture "uid" UserId :> "features" :> "conferenceCalling" - :> Servant.ReqBody '[Servant.JSON] (ApiFt.TeamFeatureStatus 'ApiFt.TeamFeatureConferenceCalling) + :> Servant.ReqBody '[Servant.JSON] (ApiFt.TeamFeatureStatus 'ApiFt.WithoutPaymentStatus 'ApiFt.TeamFeatureConferenceCalling) :> Put '[Servant.JSON] NoContent type DeleteAccountFeatureConfig = diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs index 7aafbfa7bf..5bbf41d01b 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs @@ -623,7 +623,7 @@ data Api routes = Api :- FeatureStatusPut 'TeamFeatureSearchVisibility, teamFeatureStatusSearchVisibilityDeprecatedGet :: routes - :- FeatureStatusDeprecatedGet 'TeamFeatureSearchVisibility, + :- FeatureStatusDeprecatedGet 'WithoutPaymentStatus 'TeamFeatureSearchVisibility, teamFeatureStatusSearchVisibilityDeprecatedPut :: routes :- FeatureStatusDeprecatedPut 'TeamFeatureSearchVisibility, @@ -632,13 +632,13 @@ data Api routes = Api :- FeatureStatusGet 'TeamFeatureValidateSAMLEmails, teamFeatureStatusValidateSAMLEmailsDeprecatedGet :: routes - :- FeatureStatusDeprecatedGet 'TeamFeatureValidateSAMLEmails, + :- FeatureStatusDeprecatedGet 'WithoutPaymentStatus 'TeamFeatureValidateSAMLEmails, teamFeatureStatusDigitalSignaturesGet :: routes :- FeatureStatusGet 'TeamFeatureDigitalSignatures, teamFeatureStatusDigitalSignaturesDeprecatedGet :: routes - :- FeatureStatusDeprecatedGet 'TeamFeatureDigitalSignatures, + :- FeatureStatusDeprecatedGet 'WithoutPaymentStatus 'TeamFeatureDigitalSignatures, teamFeatureStatusAppLockGet :: routes :- FeatureStatusGet 'TeamFeatureAppLock, @@ -668,34 +668,34 @@ data Api routes = Api :- AllFeatureConfigsGet, featureConfigLegalHoldGet :: routes - :- FeatureConfigGet 'TeamFeatureLegalHold, + :- FeatureConfigGet 'WithoutPaymentStatus 'TeamFeatureLegalHold, featureConfigSSOGet :: routes - :- FeatureConfigGet 'TeamFeatureSSO, + :- FeatureConfigGet 'WithoutPaymentStatus 'TeamFeatureSSO, featureConfigSearchVisibilityGet :: routes - :- FeatureConfigGet 'TeamFeatureSearchVisibility, + :- FeatureConfigGet 'WithoutPaymentStatus 'TeamFeatureSearchVisibility, featureConfigValidateSAMLEmailsGet :: routes - :- FeatureConfigGet 'TeamFeatureValidateSAMLEmails, + :- FeatureConfigGet 'WithoutPaymentStatus 'TeamFeatureValidateSAMLEmails, featureConfigDigitalSignaturesGet :: routes - :- FeatureConfigGet 'TeamFeatureDigitalSignatures, + :- FeatureConfigGet 'WithoutPaymentStatus 'TeamFeatureDigitalSignatures, featureConfigAppLockGet :: routes - :- FeatureConfigGet 'TeamFeatureAppLock, + :- FeatureConfigGet 'WithoutPaymentStatus 'TeamFeatureAppLock, featureConfigFileSharingGet :: routes - :- FeatureConfigGet 'TeamFeatureFileSharing, + :- FeatureConfigGet 'WithoutPaymentStatus 'TeamFeatureFileSharing, featureConfigClassifiedDomainsGet :: routes - :- FeatureConfigGet 'TeamFeatureClassifiedDomains, + :- FeatureConfigGet 'WithoutPaymentStatus 'TeamFeatureClassifiedDomains, featureConfigConferenceCallingGet :: routes - :- FeatureConfigGet 'TeamFeatureConferenceCalling, + :- FeatureConfigGet 'WithPaymentStatus 'TeamFeatureConferenceCalling, featureConfigSelfDeletingMessagesGet :: routes - :- FeatureConfigGet 'TeamFeatureSelfDeletingMessages + :- FeatureConfigGet 'WithPaymentStatus 'TeamFeatureSelfDeletingMessages } deriving (Generic) @@ -708,7 +708,7 @@ type FeatureStatusGet featureName = :> Capture "tid" TeamId :> "features" :> KnownTeamFeatureNameSymbol featureName - :> Get '[Servant.JSON] (TeamFeatureStatus featureName) + :> Get '[Servant.JSON] (TeamFeatureStatus 'WithPaymentStatus featureName) type FeatureStatusPut featureName = Summary (AppendSymbol "Put config for " (KnownTeamFeatureNameSymbol featureName)) @@ -717,18 +717,18 @@ type FeatureStatusPut featureName = :> Capture "tid" TeamId :> "features" :> KnownTeamFeatureNameSymbol featureName - :> ReqBody '[Servant.JSON] (TeamFeatureStatus featureName) - :> Put '[Servant.JSON] (TeamFeatureStatus featureName) + :> ReqBody '[Servant.JSON] (TeamFeatureStatus 'WithoutPaymentStatus featureName) + :> Put '[Servant.JSON] (TeamFeatureStatus 'WithoutPaymentStatus featureName) -- | A type for a GET endpoint for a feature with a deprecated path -type FeatureStatusDeprecatedGet featureName = +type FeatureStatusDeprecatedGet ps featureName = Summary (AppendSymbol "[deprecated] Get config for " (KnownTeamFeatureNameSymbol featureName)) :> ZUser :> "teams" :> Capture "tid" TeamId :> "features" :> DeprecatedFeatureName featureName - :> Get '[Servant.JSON] (TeamFeatureStatus featureName) + :> Get '[Servant.JSON] (TeamFeatureStatus ps featureName) -- | A type for a PUT endpoint for a feature with a deprecated path type FeatureStatusDeprecatedPut featureName = @@ -738,15 +738,15 @@ type FeatureStatusDeprecatedPut featureName = :> Capture "tid" TeamId :> "features" :> DeprecatedFeatureName featureName - :> ReqBody '[Servant.JSON] (TeamFeatureStatus featureName) - :> Put '[Servant.JSON] (TeamFeatureStatus featureName) + :> ReqBody '[Servant.JSON] (TeamFeatureStatus 'WithoutPaymentStatus featureName) + :> Put '[Servant.JSON] (TeamFeatureStatus 'WithoutPaymentStatus featureName) -type FeatureConfigGet featureName = +type FeatureConfigGet ps featureName = Summary (AppendSymbol "Get feature config for feature " (KnownTeamFeatureNameSymbol featureName)) :> ZUser :> "feature-configs" :> KnownTeamFeatureNameSymbol featureName - :> Get '[Servant.JSON] (TeamFeatureStatus featureName) + :> Get '[Servant.JSON] (TeamFeatureStatus ps featureName) type AllFeatureConfigsGet = Summary "Get configurations of all features" diff --git a/libs/wire-api/src/Wire/API/Routes/Public/LegalHold.hs b/libs/wire-api/src/Wire/API/Routes/Public/LegalHold.hs index 6bb24b7543..67dd19e0bc 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/LegalHold.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/LegalHold.hs @@ -52,9 +52,9 @@ type PublicAPI = type InternalAPI = "i" :> "teams" :> Capture "tid" TeamId :> "legalhold" - :> Get '[JSON] (TeamFeatureStatus 'TeamFeatureLegalHold) + :> Get '[JSON] (TeamFeatureStatus 'WithPaymentStatus 'TeamFeatureLegalHold) :<|> "i" :> "teams" :> Capture "tid" TeamId :> "legalhold" - :> ReqBody '[JSON] (TeamFeatureStatus 'TeamFeatureLegalHold) + :> ReqBody '[JSON] (TeamFeatureStatus 'WithoutPaymentStatus 'TeamFeatureLegalHold) :> Put '[] NoContent swaggerDoc :: Swagger diff --git a/libs/wire-api/src/Wire/API/Swagger.hs b/libs/wire-api/src/Wire/API/Swagger.hs index f746c3465c..7ebdb1d9c8 100644 --- a/libs/wire-api/src/Wire/API/Swagger.hs +++ b/libs/wire-api/src/Wire/API/Swagger.hs @@ -129,6 +129,7 @@ models = Team.Feature.modelTeamFeatureAppLockConfig, Team.Feature.modelTeamFeatureClassifiedDomainsConfig, Team.Feature.modelTeamFeatureSelfDeletingMessagesConfig, + Team.Feature.modelPaymentStatus, Team.Invitation.modelTeamInvitation, Team.Invitation.modelTeamInvitationList, Team.Invitation.modelTeamInvitationRequest, diff --git a/libs/wire-api/src/Wire/API/Team/Feature.hs b/libs/wire-api/src/Wire/API/Team/Feature.hs index f466fe3102..60679fba0d 100644 --- a/libs/wire-api/src/Wire/API/Team/Feature.hs +++ b/libs/wire-api/src/Wire/API/Team/Feature.hs @@ -29,12 +29,18 @@ module Wire.API.Team.Feature EnforceAppLock (..), KnownTeamFeatureName (..), TeamFeatureStatusNoConfig (..), + TeamFeatureStatusNoConfigAndPaymentStatus (..), TeamFeatureStatusWithConfig (..), + TeamFeatureStatusWithConfigAndPaymentStatus (..), HasDeprecatedFeatureName (..), AllFeatureConfigs (..), + PaymentStatus (..), + PaymentStatusValue (..), + IncludePaymentStatus (..), defaultAppLockStatus, defaultClassifiedDomains, defaultSelfDeletingMessagesStatus, + defaultConferenceCalling, -- * Swagger typeTeamFeatureName, @@ -44,7 +50,10 @@ module Wire.API.Team.Feature modelTeamFeatureAppLockConfig, modelTeamFeatureClassifiedDomainsConfig, modelTeamFeatureSelfDeletingMessagesConfig, + modelTeamFeatureStatusWithConfigAndPaymentStatus, + modelTeamFeatureStatusNoConfigAndPaymentStatus, modelForTeamFeature, + modelPaymentStatus, ) where @@ -52,8 +61,9 @@ 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 (..), toByteString') +import Data.ByteString.Conversion (FromByteString (..), ToByteString (..), fromByteString, toByteString') import Data.Domain (Domain) +import Data.Either.Extra (maybeToEither) import Data.Kind (Constraint) import Data.Schema import Data.String.Conversions (cs) @@ -64,6 +74,7 @@ import qualified Data.Text.Encoding as T import Deriving.Aeson import GHC.TypeLits (Symbol) import Imports +import Servant (FromHttpApiData (..)) import Test.QuickCheck.Arbitrary (arbitrary) import Wire.API.Arbitrary (Arbitrary, GenericUniform (..)) @@ -272,8 +283,8 @@ instance Cass.Cql TeamFeatureStatusValue where ctype = Cass.Tagged Cass.IntColumn fromCql (Cass.CqlInt n) = case n of - 0 -> pure $ TeamFeatureDisabled - 1 -> pure $ TeamFeatureEnabled + 0 -> pure TeamFeatureDisabled + 1 -> pure TeamFeatureEnabled _ -> Left "fromCql: Invalid TeamFeatureStatusValue" fromCql _ = Left "fromCql: TeamFeatureStatusValue: CqlInt expected" @@ -283,19 +294,25 @@ instance Cass.Cql TeamFeatureStatusValue where ---------------------------------------------------------------------- -- TeamFeatureStatus -type family TeamFeatureStatus (a :: TeamFeatureName) :: * where - TeamFeatureStatus 'TeamFeatureLegalHold = TeamFeatureStatusNoConfig - TeamFeatureStatus 'TeamFeatureSSO = TeamFeatureStatusNoConfig - TeamFeatureStatus 'TeamFeatureSearchVisibility = TeamFeatureStatusNoConfig - TeamFeatureStatus 'TeamFeatureValidateSAMLEmails = TeamFeatureStatusNoConfig - TeamFeatureStatus 'TeamFeatureDigitalSignatures = TeamFeatureStatusNoConfig - TeamFeatureStatus 'TeamFeatureAppLock = TeamFeatureStatusWithConfig TeamFeatureAppLockConfig - TeamFeatureStatus 'TeamFeatureFileSharing = TeamFeatureStatusNoConfig - TeamFeatureStatus 'TeamFeatureClassifiedDomains = TeamFeatureStatusWithConfig TeamFeatureClassifiedDomainsConfig - TeamFeatureStatus 'TeamFeatureConferenceCalling = TeamFeatureStatusNoConfig - TeamFeatureStatus 'TeamFeatureSelfDeletingMessages = TeamFeatureStatusWithConfig TeamFeatureSelfDeletingMessagesConfig - -type FeatureHasNoConfig (a :: TeamFeatureName) = (TeamFeatureStatus a ~ TeamFeatureStatusNoConfig) :: Constraint +data IncludePaymentStatus = WithPaymentStatus | WithoutPaymentStatus + +type family TeamFeatureStatus (ps :: IncludePaymentStatus) (a :: TeamFeatureName) :: * where + TeamFeatureStatus _ 'TeamFeatureLegalHold = TeamFeatureStatusNoConfig + TeamFeatureStatus _ 'TeamFeatureSSO = TeamFeatureStatusNoConfig + TeamFeatureStatus _ 'TeamFeatureSearchVisibility = TeamFeatureStatusNoConfig + TeamFeatureStatus _ 'TeamFeatureValidateSAMLEmails = TeamFeatureStatusNoConfig + TeamFeatureStatus _ 'TeamFeatureDigitalSignatures = TeamFeatureStatusNoConfig + TeamFeatureStatus _ 'TeamFeatureAppLock = TeamFeatureStatusWithConfig TeamFeatureAppLockConfig + TeamFeatureStatus _ 'TeamFeatureFileSharing = TeamFeatureStatusNoConfig + TeamFeatureStatus _ 'TeamFeatureClassifiedDomains = TeamFeatureStatusWithConfig TeamFeatureClassifiedDomainsConfig + TeamFeatureStatus 'WithoutPaymentStatus 'TeamFeatureConferenceCalling = TeamFeatureStatusNoConfig + TeamFeatureStatus 'WithPaymentStatus 'TeamFeatureConferenceCalling = TeamFeatureStatusNoConfigAndPaymentStatus + TeamFeatureStatus 'WithoutPaymentStatus 'TeamFeatureSelfDeletingMessages = TeamFeatureStatusWithConfig TeamFeatureSelfDeletingMessagesConfig + TeamFeatureStatus 'WithPaymentStatus 'TeamFeatureSelfDeletingMessages = TeamFeatureStatusWithConfigAndPaymentStatus TeamFeatureSelfDeletingMessagesConfig + +type family FeatureHasNoConfig (ps :: IncludePaymentStatus) (a :: TeamFeatureName) :: Constraint where + FeatureHasNoConfig 'WithPaymentStatus a = (TeamFeatureStatus 'WithPaymentStatus a ~ TeamFeatureStatusNoConfigAndPaymentStatus) + FeatureHasNoConfig 'WithoutPaymentStatus a = (TeamFeatureStatus 'WithoutPaymentStatus a ~ TeamFeatureStatusNoConfig) -- if you add a new constructor here, don't forget to add it to the swagger (1.2) docs in "Wire.API.Swagger"! modelForTeamFeature :: TeamFeatureName -> Doc.Model @@ -330,6 +347,29 @@ instance ToSchema TeamFeatureStatusNoConfig where TeamFeatureStatusNoConfig <$> tfwoStatus .= field "status" schema +data TeamFeatureStatusNoConfigAndPaymentStatus = TeamFeatureStatusNoConfigAndPaymentStatus + { tfwoapsStatus :: TeamFeatureStatusValue, + tfwoapsPaymentStatus :: PaymentStatusValue + } + deriving stock (Eq, Show, Generic, Typeable) + deriving (ToJSON, FromJSON, S.ToSchema) via (Schema TeamFeatureStatusNoConfigAndPaymentStatus) + +instance Arbitrary TeamFeatureStatusNoConfigAndPaymentStatus where + arbitrary = TeamFeatureStatusNoConfigAndPaymentStatus <$> arbitrary <*> arbitrary + +modelTeamFeatureStatusNoConfigAndPaymentStatus :: Doc.Model +modelTeamFeatureStatusNoConfigAndPaymentStatus = Doc.defineModel "TeamFeatureStatusNoConfigAndPaymentStatus" $ do + Doc.description "Team feature that has no configuration beyond the boolean on/off switch and a payment status" + Doc.property "status" typeTeamFeatureStatusValue $ Doc.description "" + Doc.property "paymentStatus" typePaymentStatusValue $ Doc.description "" + +instance ToSchema TeamFeatureStatusNoConfigAndPaymentStatus where + schema = + object "TeamFeatureStatusNoConfigAndPaymentStatus" $ + TeamFeatureStatusNoConfigAndPaymentStatus + <$> tfwoapsStatus .= field "status" schema + <*> tfwoapsPaymentStatus .= field "paymentStatus" schema + ---------------------------------------------------------------------- -- TeamFeatureStatusWithConfig @@ -360,6 +400,32 @@ instance ToSchema cfg => ToSchema (TeamFeatureStatusWithConfig cfg) where <$> tfwcStatus .= field "status" schema <*> tfwcConfig .= field "config" schema +data TeamFeatureStatusWithConfigAndPaymentStatus (cfg :: *) = TeamFeatureStatusWithConfigAndPaymentStatus + { tfwcapsStatus :: TeamFeatureStatusValue, + tfwcapsConfig :: cfg, + tfwcapsPaymentStatus :: PaymentStatusValue + } + deriving stock (Eq, Show, Generic, Typeable) + deriving (ToJSON, FromJSON, S.ToSchema) via (Schema (TeamFeatureStatusWithConfigAndPaymentStatus cfg)) + +instance Arbitrary cfg => Arbitrary (TeamFeatureStatusWithConfigAndPaymentStatus cfg) where + arbitrary = TeamFeatureStatusWithConfigAndPaymentStatus <$> arbitrary <*> arbitrary <*> arbitrary + +modelTeamFeatureStatusWithConfigAndPaymentStatus :: TeamFeatureName -> Doc.Model -> Doc.Model +modelTeamFeatureStatusWithConfigAndPaymentStatus name cfgModel = Doc.defineModel (cs $ show name) $ do + Doc.description $ "Status and config of " <> cs (show name) + Doc.property "status" typeTeamFeatureStatusValue $ Doc.description "status" + Doc.property "config" (Doc.ref cfgModel) $ Doc.description "config" + Doc.property "paymentStatus" typePaymentStatusValue $ Doc.description "config" + +instance ToSchema cfg => ToSchema (TeamFeatureStatusWithConfigAndPaymentStatus cfg) where + schema = + object "TeamFeatureStatusWithConfigAndPaymentStatus" $ + TeamFeatureStatusWithConfigAndPaymentStatus + <$> tfwcapsStatus .= field "status" schema + <*> tfwcapsConfig .= field "config" schema + <*> tfwcapsPaymentStatus .= field "paymentStatus" schema + ---------------------------------------------------------------------- -- TeamFeatureClassifiedDomainsConfig @@ -383,7 +449,10 @@ modelTeamFeatureClassifiedDomainsConfig = Doc.property "domains" (Doc.array Doc.string') $ Doc.description "domains" defaultClassifiedDomains :: TeamFeatureStatusWithConfig TeamFeatureClassifiedDomainsConfig -defaultClassifiedDomains = TeamFeatureStatusWithConfig TeamFeatureDisabled (TeamFeatureClassifiedDomainsConfig []) +defaultClassifiedDomains = + TeamFeatureStatusWithConfig + TeamFeatureDisabled + (TeamFeatureClassifiedDomainsConfig []) ---------------------------------------------------------------------- -- TeamFeatureAppLockConfig @@ -427,7 +496,7 @@ defaultAppLockStatus = ---------------------------------------------------------------------- -- TeamFeatureSelfDeletingMessagesConfig -data TeamFeatureSelfDeletingMessagesConfig = TeamFeatureSelfDeletingMessagesConfig +newtype TeamFeatureSelfDeletingMessagesConfig = TeamFeatureSelfDeletingMessagesConfig { sdmEnforcedTimeoutSeconds :: Int32 } deriving stock (Eq, Show, Generic) @@ -445,11 +514,88 @@ modelTeamFeatureSelfDeletingMessagesConfig = Doc.defineModel "TeamFeatureSelfDeletingMessagesConfig" $ do Doc.property "enforcedTimeoutSeconds" Doc.int32' $ Doc.description "optional; default: `0` (no enforcement)" -defaultSelfDeletingMessagesStatus :: TeamFeatureStatusWithConfig TeamFeatureSelfDeletingMessagesConfig +defaultSelfDeletingMessagesStatus :: TeamFeatureStatusWithConfigAndPaymentStatus TeamFeatureSelfDeletingMessagesConfig defaultSelfDeletingMessagesStatus = - TeamFeatureStatusWithConfig + TeamFeatureStatusWithConfigAndPaymentStatus TeamFeatureEnabled (TeamFeatureSelfDeletingMessagesConfig 0) + PaymentLocked + +---------------------------------------------------------------------- +-- TeamFeatureConferenceCalling + +defaultConferenceCalling :: TeamFeatureStatusNoConfigAndPaymentStatus +defaultConferenceCalling = TeamFeatureStatusNoConfigAndPaymentStatus TeamFeatureEnabled PaymentLocked + +---------------------------------------------------------------------- +-- PaymentStatus + +instance FromHttpApiData PaymentStatusValue where + parseUrlPiece = maybeToEither "Invalid payment status" . fromByteString . cs + +data PaymentStatusValue = PaymentLocked | PaymentUnlocked + deriving stock (Eq, Show, Generic) + deriving (Arbitrary) via (GenericUniform PaymentStatusValue) + deriving (ToJSON, FromJSON, S.ToSchema) via (Schema PaymentStatusValue) + +newtype PaymentStatus = PaymentStatus + { paymentStatus :: PaymentStatusValue + } + deriving stock (Eq, Show, Generic) + deriving (FromJSON, ToJSON, S.ToSchema) via (Schema PaymentStatus) + deriving (Arbitrary) via (GenericUniform PaymentStatus) + +instance ToSchema PaymentStatus where + schema = + object "PaymentStatus" $ + PaymentStatus + <$> paymentStatus .= field "paymentStatus" schema + +modelPaymentStatus :: Doc.Model +modelPaymentStatus = + Doc.defineModel "PaymentStatus" $ do + Doc.property "paymentStatus" typePaymentStatusValue $ Doc.description "" + +typePaymentStatusValue :: Doc.DataType +typePaymentStatusValue = + Doc.string $ + Doc.enum + [ "locked", + "unlocked" + ] + +instance ToSchema PaymentStatusValue where + schema = + enum @Text "PaymentStatusValue" $ + mconcat + [ element "locked" PaymentLocked, + element "unlocked" PaymentUnlocked + ] + +instance ToByteString PaymentStatusValue where + builder PaymentLocked = "locked" + builder PaymentUnlocked = "unlocked" + +instance FromByteString PaymentStatusValue where + parser = + Parser.takeByteString >>= \b -> + case T.decodeUtf8' b of + Right "locked" -> pure PaymentLocked + Right "unlocked" -> pure PaymentUnlocked + Right t -> fail $ "Invalid PaymentStatusValue: " <> T.unpack t + Left e -> fail $ "Invalid PaymentStatusValue: " <> show e + +instance Cass.Cql PaymentStatusValue where + ctype = Cass.Tagged Cass.IntColumn + + fromCql (Cass.CqlInt n) = case n of + 0 -> pure PaymentLocked + 1 -> pure PaymentUnlocked + _ -> Left "fromCql: Invalid PaymentStatusValue" + fromCql _ = Left "fromCql: PaymentStatusValue: CqlInt expected" + + toCql PaymentLocked = Cass.CqlInt 0 + toCql PaymentUnlocked = Cass.CqlInt 1 ---------------------------------------------------------------------- -- internal diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generator.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generator.hs index 4d022f0eac..3480c55814 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generator.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generator.hs @@ -328,8 +328,8 @@ generateTestModule = do generateBindingModule @Team.TeamDeleteData "team" ref generateBindingModule @Team.Conversation.TeamConversation "team" ref generateBindingModule @Team.Conversation.TeamConversationList "team" ref - generateBindingModule @(Team.Feature.TeamFeatureStatus 'Team.Feature.TeamFeatureLegalHold) "team" ref - generateBindingModule @(Team.Feature.TeamFeatureStatus 'Team.Feature.TeamFeatureAppLock) "team" ref + generateBindingModule @(Team.Feature.TeamFeatureStatus 'Team.Feature.WithoutPaymentStatus 'Team.Feature.TeamFeatureLegalHold) "team" ref + generateBindingModule @(Team.Feature.TeamFeatureStatus 'Team.Feature.WithoutPaymentStatus 'Team.Feature.TeamFeatureAppLock) "team" ref generateBindingModule @Team.Feature.TeamFeatureStatusValue "team" ref generateBindingModule @Team.Invitation.InvitationRequest "team" ref generateBindingModule @Team.Invitation.Invitation "team" ref 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 6e09181e54..220c31e50c 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 @@ -195,17 +195,21 @@ tests = testRoundTrip @Team.TeamDeleteData, testRoundTrip @Team.Conversation.TeamConversation, testRoundTrip @Team.Conversation.TeamConversationList, - testRoundTrip @(Team.Feature.TeamFeatureStatus 'Team.Feature.TeamFeatureLegalHold), - testRoundTrip @(Team.Feature.TeamFeatureStatus 'Team.Feature.TeamFeatureSSO), - testRoundTrip @(Team.Feature.TeamFeatureStatus 'Team.Feature.TeamFeatureSearchVisibility), - testRoundTrip @(Team.Feature.TeamFeatureStatus 'Team.Feature.TeamFeatureValidateSAMLEmails), - testRoundTrip @(Team.Feature.TeamFeatureStatus 'Team.Feature.TeamFeatureDigitalSignatures), - testRoundTrip @(Team.Feature.TeamFeatureStatus 'Team.Feature.TeamFeatureAppLock), - testRoundTrip @(Team.Feature.TeamFeatureStatus 'Team.Feature.TeamFeatureFileSharing), - testRoundTrip @(Team.Feature.TeamFeatureStatus 'Team.Feature.TeamFeatureClassifiedDomains), - testRoundTrip @(Team.Feature.TeamFeatureStatus 'Team.Feature.TeamFeatureConferenceCalling), - testRoundTrip @(Team.Feature.TeamFeatureStatus 'Team.Feature.TeamFeatureSelfDeletingMessages), + testRoundTrip @(Team.Feature.TeamFeatureStatus 'Team.Feature.WithoutPaymentStatus 'Team.Feature.TeamFeatureLegalHold), + testRoundTrip @(Team.Feature.TeamFeatureStatus 'Team.Feature.WithoutPaymentStatus 'Team.Feature.TeamFeatureSSO), + testRoundTrip @(Team.Feature.TeamFeatureStatus 'Team.Feature.WithoutPaymentStatus 'Team.Feature.TeamFeatureSearchVisibility), + testRoundTrip @(Team.Feature.TeamFeatureStatus 'Team.Feature.WithoutPaymentStatus 'Team.Feature.TeamFeatureValidateSAMLEmails), + testRoundTrip @(Team.Feature.TeamFeatureStatus 'Team.Feature.WithoutPaymentStatus 'Team.Feature.TeamFeatureDigitalSignatures), + testRoundTrip @(Team.Feature.TeamFeatureStatus 'Team.Feature.WithoutPaymentStatus 'Team.Feature.TeamFeatureAppLock), + testRoundTrip @(Team.Feature.TeamFeatureStatus 'Team.Feature.WithoutPaymentStatus 'Team.Feature.TeamFeatureFileSharing), + testRoundTrip @(Team.Feature.TeamFeatureStatus 'Team.Feature.WithoutPaymentStatus 'Team.Feature.TeamFeatureClassifiedDomains), + testRoundTrip @(Team.Feature.TeamFeatureStatus 'Team.Feature.WithoutPaymentStatus 'Team.Feature.TeamFeatureConferenceCalling), + testRoundTrip @(Team.Feature.TeamFeatureStatus 'Team.Feature.WithoutPaymentStatus 'Team.Feature.TeamFeatureSelfDeletingMessages), + testRoundTrip @(Team.Feature.TeamFeatureStatus 'Team.Feature.WithPaymentStatus 'Team.Feature.TeamFeatureSelfDeletingMessages), + testRoundTrip @(Team.Feature.TeamFeatureStatus 'Team.Feature.WithoutPaymentStatus 'Team.Feature.TeamFeatureSelfDeletingMessages), testRoundTrip @Team.Feature.TeamFeatureStatusValue, + testRoundTrip @Team.Feature.PaymentStatusValue, + testRoundTrip @Team.Feature.PaymentStatus, testRoundTrip @Team.Invitation.InvitationRequest, testRoundTrip @Team.Invitation.Invitation, testRoundTrip @Team.Invitation.InvitationList, diff --git a/services/brig/src/Brig/IO/Intra.hs b/services/brig/src/Brig/IO/Intra.hs index df063cbdd0..f7192d3c36 100644 --- a/services/brig/src/Brig/IO/Intra.hs +++ b/services/brig/src/Brig/IO/Intra.hs @@ -121,7 +121,7 @@ import Wire.API.Federation.API.Brig import Wire.API.Federation.Client import Wire.API.Federation.Error (federationNotImplemented) import Wire.API.Message (UserClients) -import Wire.API.Team.Feature (TeamFeatureName (..), TeamFeatureStatus) +import Wire.API.Team.Feature (IncludePaymentStatus (..), TeamFeatureName (..), TeamFeatureStatus) import Wire.API.Team.LegalHold (LegalholdProtectee) ----------------------------------------------------------------------------- @@ -968,7 +968,7 @@ getTeamName tid = do . expect2xx -- | Calls 'Galley.API.getTeamFeatureStatusH'. -getTeamLegalHoldStatus :: TeamId -> AppIO (TeamFeatureStatus 'TeamFeatureLegalHold) +getTeamLegalHoldStatus :: TeamId -> AppIO (TeamFeatureStatus 'WithoutPaymentStatus 'TeamFeatureLegalHold) getTeamLegalHoldStatus tid = do debug $ remote "galley" . msg (val "Get legalhold settings") galleyRequest GET req >>= decodeBody "galley" diff --git a/services/brig/src/Brig/Options.hs b/services/brig/src/Brig/Options.hs index 7710b7608e..cd8d5f8603 100644 --- a/services/brig/src/Brig/Options.hs +++ b/services/brig/src/Brig/Options.hs @@ -508,8 +508,8 @@ data Settings = Settings -- they are grandfathered), and feature-specific extra data (eg., TLL for self-deleting -- messages). For now, we have something quick & simple. data AccountFeatureConfigs = AccountFeatureConfigs - { afcConferenceCallingDefNew :: !(ApiFT.TeamFeatureStatus 'ApiFT.TeamFeatureConferenceCalling), - afcConferenceCallingDefNull :: !(ApiFT.TeamFeatureStatus 'ApiFT.TeamFeatureConferenceCalling) + { afcConferenceCallingDefNew :: !(ApiFT.TeamFeatureStatus 'ApiFT.WithoutPaymentStatus 'ApiFT.TeamFeatureConferenceCalling), + afcConferenceCallingDefNull :: !(ApiFT.TeamFeatureStatus 'ApiFT.WithoutPaymentStatus 'ApiFT.TeamFeatureConferenceCalling) } deriving (Show, Eq, Generic) deriving (Arbitrary) via (GenericUniform AccountFeatureConfigs) diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index b1f68193ca..e58d7f2406 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -437,6 +437,8 @@ executable galley-schema V52_FeatureConferenceCalling V53_AddRemoteConvStatus V54_TeamFeatureSelfDeletingMessages + V55_SelfDeletingMessagesPaymentStatus + V56_ConferenceCallingPaymentStatus Paths_galley hs-source-dirs: schema/src diff --git a/services/galley/schema/src/Main.hs b/services/galley/schema/src/Main.hs index 369a464436..564c3c1e09 100644 --- a/services/galley/schema/src/Main.hs +++ b/services/galley/schema/src/Main.hs @@ -57,6 +57,8 @@ import qualified V51_FeatureFileSharing import qualified V52_FeatureConferenceCalling import qualified V53_AddRemoteConvStatus import qualified V54_TeamFeatureSelfDeletingMessages +import qualified V55_SelfDeletingMessagesPaymentStatus +import qualified V56_ConferenceCallingPaymentStatus main :: IO () main = do @@ -99,9 +101,11 @@ main = do V51_FeatureFileSharing.migration, V52_FeatureConferenceCalling.migration, V53_AddRemoteConvStatus.migration, - V54_TeamFeatureSelfDeletingMessages.migration + V54_TeamFeatureSelfDeletingMessages.migration, + V55_SelfDeletingMessagesPaymentStatus.migration, + V56_ConferenceCallingPaymentStatus.migration -- When adding migrations here, don't forget to update - -- 'schemaVersion' in Galley.Data + -- 'schemaVersion' in Galley.Cassandra -- (see also docs/developer/cassandra-interaction.md) -- -- FUTUREWORK: once #1726 has made its way to master/production, diff --git a/services/galley/schema/src/V55_SelfDeletingMessagesPaymentStatus.hs b/services/galley/schema/src/V55_SelfDeletingMessagesPaymentStatus.hs new file mode 100644 index 0000000000..fa7ed93e8b --- /dev/null +++ b/services/galley/schema/src/V55_SelfDeletingMessagesPaymentStatus.hs @@ -0,0 +1,33 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2020 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 V55_SelfDeletingMessagesPaymentStatus + ( migration, + ) +where + +import Cassandra.Schema +import Imports +import Text.RawString.QQ + +migration :: Migration +migration = Migration 55 "Add payment status config for self deleting messages team feature" $ do + schema' + [r| ALTER TABLE team_features ADD ( + self_deleting_messages_payment_status int + ) + |] diff --git a/services/galley/schema/src/V56_ConferenceCallingPaymentStatus.hs b/services/galley/schema/src/V56_ConferenceCallingPaymentStatus.hs new file mode 100644 index 0000000000..e4c67febd0 --- /dev/null +++ b/services/galley/schema/src/V56_ConferenceCallingPaymentStatus.hs @@ -0,0 +1,33 @@ + -- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2020 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 V56_ConferenceCallingPaymentStatus + ( migration, + ) +where + +import Cassandra.Schema +import Imports +import Text.RawString.QQ + +migration :: Migration +migration = Migration 56 "Add payment status config for conference calling" $ do + schema' + [r| ALTER TABLE team_features ADD ( + conference_calling_payment_status int + ) + |] diff --git a/services/galley/src/Galley/API/Error.hs b/services/galley/src/Galley/API/Error.hs index 34c6ec0d3c..6c1b604dfd 100644 --- a/services/galley/src/Galley/API/Error.hs +++ b/services/galley/src/Galley/API/Error.hs @@ -161,12 +161,14 @@ data TeamFeatureError | LegalHoldFeatureFlagNotEnabled | LegalHoldWhitelistedOnly | DisableSsoNotImplemented + | PaymentStatusLocked instance APIError TeamFeatureError where toWai AppLockinactivityTimeoutTooLow = inactivityTimeoutTooLow toWai LegalHoldFeatureFlagNotEnabled = legalHoldFeatureFlagNotEnabled toWai LegalHoldWhitelistedOnly = legalHoldWhitelistedOnly toWai DisableSsoNotImplemented = disableSsoNotImplemented + toWai PaymentStatusLocked = setTeamFeatureConfigPaymentStatusLocked data TeamNotificationError = InvalidTeamNotificationId @@ -458,6 +460,9 @@ noLegalHoldDeviceAllocated = mkError status404 "legalhold-no-device-allocated" " legalHoldCouldNotBlockConnections :: Error legalHoldCouldNotBlockConnections = mkError status500 "legalhold-internal" "legal hold service: could not block connections when resolving policy conflicts." +setTeamFeatureConfigPaymentStatusLocked :: Error +setTeamFeatureConfigPaymentStatusLocked = mkError status409 "payment-status-locked" "feature config cannot be updated when the payment status is locked" + disableSsoNotImplemented :: Error disableSsoNotImplemented = mkError diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index 5c5a555b92..050b0bee13 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -52,6 +52,7 @@ import Galley.API.Util import Galley.App import Galley.Cassandra.Paging import qualified Galley.Data.Conversation as Data +import Galley.Data.TeamFeatures (MaybeHasPaymentStatusCol) import Galley.Effects import Galley.Effects.ClientStore import Galley.Effects.ConversationStore @@ -121,79 +122,85 @@ data InternalApi routes = InternalApi -- Viewing the config for features should be allowed for any admin. iTeamFeatureStatusSSOGet :: routes - :- IFeatureStatusGet 'Public.TeamFeatureSSO, + :- IFeatureStatusGet 'Public.WithoutPaymentStatus 'Public.TeamFeatureSSO, iTeamFeatureStatusSSOPut :: routes :- IFeatureStatusPut 'Public.TeamFeatureSSO, iTeamFeatureStatusLegalHoldGet :: routes - :- IFeatureStatusGet 'Public.TeamFeatureLegalHold, + :- IFeatureStatusGet 'Public.WithoutPaymentStatus 'Public.TeamFeatureLegalHold, iTeamFeatureStatusLegalHoldPut :: routes :- IFeatureStatusPut 'Public.TeamFeatureLegalHold, iTeamFeatureStatusSearchVisibilityGet :: routes - :- IFeatureStatusGet 'Public.TeamFeatureSearchVisibility, + :- IFeatureStatusGet 'Public.WithoutPaymentStatus 'Public.TeamFeatureSearchVisibility, iTeamFeatureStatusSearchVisibilityPut :: routes :- IFeatureStatusPut 'Public.TeamFeatureSearchVisibility, iTeamFeatureStatusSearchVisibilityDeprecatedGet :: routes - :- IFeatureStatusDeprecatedGet 'Public.TeamFeatureSearchVisibility, + :- IFeatureStatusDeprecatedGet 'Public.WithoutPaymentStatus 'Public.TeamFeatureSearchVisibility, iTeamFeatureStatusSearchVisibilityDeprecatedPut :: routes :- IFeatureStatusDeprecatedPut 'Public.TeamFeatureSearchVisibility, iTeamFeatureStatusValidateSAMLEmailsGet :: routes - :- IFeatureStatusGet 'Public.TeamFeatureValidateSAMLEmails, + :- IFeatureStatusGet 'Public.WithoutPaymentStatus 'Public.TeamFeatureValidateSAMLEmails, iTeamFeatureStatusValidateSAMLEmailsPut :: routes :- IFeatureStatusPut 'Public.TeamFeatureValidateSAMLEmails, iTeamFeatureStatusValidateSAMLEmailsDeprecatedGet :: routes - :- IFeatureStatusDeprecatedGet 'Public.TeamFeatureValidateSAMLEmails, + :- IFeatureStatusDeprecatedGet 'Public.WithoutPaymentStatus 'Public.TeamFeatureValidateSAMLEmails, iTeamFeatureStatusValidateSAMLEmailsDeprecatedPut :: routes :- IFeatureStatusDeprecatedPut 'Public.TeamFeatureValidateSAMLEmails, iTeamFeatureStatusDigitalSignaturesGet :: routes - :- IFeatureStatusGet 'Public.TeamFeatureDigitalSignatures, + :- IFeatureStatusGet 'Public.WithoutPaymentStatus 'Public.TeamFeatureDigitalSignatures, iTeamFeatureStatusDigitalSignaturesPut :: routes :- IFeatureStatusPut 'Public.TeamFeatureDigitalSignatures, iTeamFeatureStatusDigitalSignaturesDeprecatedGet :: routes - :- IFeatureStatusDeprecatedGet 'Public.TeamFeatureDigitalSignatures, + :- IFeatureStatusDeprecatedGet 'Public.WithoutPaymentStatus 'Public.TeamFeatureDigitalSignatures, iTeamFeatureStatusDigitalSignaturesDeprecatedPut :: routes :- IFeatureStatusDeprecatedPut 'Public.TeamFeatureDigitalSignatures, iTeamFeatureStatusAppLockGet :: routes - :- IFeatureStatusGet 'Public.TeamFeatureAppLock, + :- IFeatureStatusGet 'Public.WithoutPaymentStatus 'Public.TeamFeatureAppLock, iTeamFeatureStatusAppLockPut :: routes :- IFeatureStatusPut 'Public.TeamFeatureAppLock, iTeamFeatureStatusFileSharingGet :: routes - :- IFeatureStatusGet 'Public.TeamFeatureFileSharing, + :- IFeatureStatusGet 'Public.WithoutPaymentStatus 'Public.TeamFeatureFileSharing, iTeamFeatureStatusFileSharingPut :: routes :- IFeatureStatusPut 'Public.TeamFeatureFileSharing, iTeamFeatureStatusClassifiedDomainsGet :: routes - :- IFeatureStatusGet 'Public.TeamFeatureClassifiedDomains, + :- IFeatureStatusGet 'Public.WithoutPaymentStatus 'Public.TeamFeatureClassifiedDomains, iTeamFeatureStatusConferenceCallingPut :: routes :- IFeatureStatusPut 'Public.TeamFeatureConferenceCalling, iTeamFeatureStatusConferenceCallingGet :: routes - :- IFeatureStatusGet 'Public.TeamFeatureConferenceCalling, + :- IFeatureStatusGet 'Public.WithPaymentStatus 'Public.TeamFeatureConferenceCalling, iTeamFeatureStatusSelfDeletingMessagesPut :: routes :- IFeatureStatusPut 'Public.TeamFeatureSelfDeletingMessages, iTeamFeatureStatusSelfDeletingMessagesGet :: routes - :- IFeatureStatusGet 'Public.TeamFeatureSelfDeletingMessages, + :- IFeatureStatusGet 'Public.WithPaymentStatus 'Public.TeamFeatureSelfDeletingMessages, + iTeamFeaturePaymentStatusSelfDeletingMessagesPut :: + routes + :- IFeatureStatusPaymentStatusPut 'Public.TeamFeatureSelfDeletingMessages, + iTeamFeaturePaymentStatusConferenceCallingPut :: + routes + :- IFeatureStatusPaymentStatusPut 'Public.TeamFeatureConferenceCalling, -- This endpoint can lead to the following events being sent: -- - MemberLeave event to members for all conversations the user was in iDeleteUser :: @@ -232,14 +239,14 @@ data InternalApi routes = InternalApi type ServantAPI = ToServantApi InternalApi -type IFeatureStatusGet featureName = +type IFeatureStatusGet paymentStatus featureName = Summary (AppendSymbol "Get config for " (Public.KnownTeamFeatureNameSymbol featureName)) :> "i" :> "teams" :> Capture "tid" TeamId :> "features" :> Public.KnownTeamFeatureNameSymbol featureName - :> Get '[Servant.JSON] (Public.TeamFeatureStatus featureName) + :> Get '[Servant.JSON] (Public.TeamFeatureStatus paymentStatus featureName) type IFeatureStatusPut featureName = Summary (AppendSymbol "Put config for " (Public.KnownTeamFeatureNameSymbol featureName)) @@ -248,18 +255,28 @@ type IFeatureStatusPut featureName = :> Capture "tid" TeamId :> "features" :> Public.KnownTeamFeatureNameSymbol featureName - :> ReqBody '[Servant.JSON] (Public.TeamFeatureStatus featureName) - :> Put '[Servant.JSON] (Public.TeamFeatureStatus featureName) + :> ReqBody '[Servant.JSON] (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus featureName) + :> Put '[Servant.JSON] (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus featureName) + +type IFeatureStatusPaymentStatusPut featureName = + Summary (AppendSymbol "(Un-)lock payment for " (Public.KnownTeamFeatureNameSymbol featureName)) + :> "i" + :> "teams" + :> Capture "tid" TeamId + :> "features" + :> Public.KnownTeamFeatureNameSymbol featureName + :> Capture "paymentStatus" Public.PaymentStatusValue + :> Put '[Servant.JSON] Public.PaymentStatus -- | A type for a GET endpoint for a feature with a deprecated path -type IFeatureStatusDeprecatedGet featureName = +type IFeatureStatusDeprecatedGet paymentStatus featureName = Summary (AppendSymbol "[deprecated] Get config for " (Public.KnownTeamFeatureNameSymbol featureName)) :> "i" :> "teams" :> Capture "tid" TeamId :> "features" :> Public.DeprecatedFeatureName featureName - :> Get '[Servant.JSON] (Public.TeamFeatureStatus featureName) + :> Get '[Servant.JSON] (Public.TeamFeatureStatus paymentStatus featureName) -- | A type for a PUT endpoint for a feature with a deprecated path type IFeatureStatusDeprecatedPut featureName = @@ -269,8 +286,8 @@ type IFeatureStatusDeprecatedPut featureName = :> Capture "tid" TeamId :> "features" :> Public.DeprecatedFeatureName featureName - :> ReqBody '[Servant.JSON] (Public.TeamFeatureStatus featureName) - :> Put '[Servant.JSON] (Public.TeamFeatureStatus featureName) + :> ReqBody '[Servant.JSON] (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus featureName) + :> Put '[Servant.JSON] (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus featureName) servantSitemap :: ServerT ServantAPI (Sem GalleyEffects) servantSitemap = @@ -278,38 +295,40 @@ servantSitemap = InternalApi { iStatusGet = pure NoContent, iStatusHead = pure NoContent, - iTeamFeatureStatusSSOGet = iGetTeamFeature @'Public.TeamFeatureSSO Features.getSSOStatusInternal, + iTeamFeatureStatusSSOGet = iGetTeamFeature @'Public.WithoutPaymentStatus @'Public.TeamFeatureSSO Features.getSSOStatusInternal, iTeamFeatureStatusSSOPut = iPutTeamFeature @'Public.TeamFeatureSSO Features.setSSOStatusInternal, - iTeamFeatureStatusLegalHoldGet = iGetTeamFeature @'Public.TeamFeatureLegalHold Features.getLegalholdStatusInternal, + iTeamFeatureStatusLegalHoldGet = iGetTeamFeature @'Public.WithoutPaymentStatus @'Public.TeamFeatureLegalHold Features.getLegalholdStatusInternal, iTeamFeatureStatusLegalHoldPut = iPutTeamFeature @'Public.TeamFeatureLegalHold (Features.setLegalholdStatusInternal @InternalPaging), - iTeamFeatureStatusSearchVisibilityGet = iGetTeamFeature @'Public.TeamFeatureSearchVisibility Features.getTeamSearchVisibilityAvailableInternal, + iTeamFeatureStatusSearchVisibilityGet = iGetTeamFeature @'Public.WithoutPaymentStatus @'Public.TeamFeatureSearchVisibility Features.getTeamSearchVisibilityAvailableInternal, iTeamFeatureStatusSearchVisibilityPut = iPutTeamFeature @'Public.TeamFeatureLegalHold Features.setTeamSearchVisibilityAvailableInternal, - iTeamFeatureStatusSearchVisibilityDeprecatedGet = iGetTeamFeature @'Public.TeamFeatureSearchVisibility Features.getTeamSearchVisibilityAvailableInternal, + iTeamFeatureStatusSearchVisibilityDeprecatedGet = iGetTeamFeature @'Public.WithoutPaymentStatus @'Public.TeamFeatureSearchVisibility Features.getTeamSearchVisibilityAvailableInternal, iTeamFeatureStatusSearchVisibilityDeprecatedPut = iPutTeamFeature @'Public.TeamFeatureLegalHold Features.setTeamSearchVisibilityAvailableInternal, - iTeamFeatureStatusValidateSAMLEmailsGet = iGetTeamFeature @'Public.TeamFeatureValidateSAMLEmails Features.getValidateSAMLEmailsInternal, + iTeamFeatureStatusValidateSAMLEmailsGet = iGetTeamFeature @'Public.WithoutPaymentStatus @'Public.TeamFeatureValidateSAMLEmails Features.getValidateSAMLEmailsInternal, iTeamFeatureStatusValidateSAMLEmailsPut = iPutTeamFeature @'Public.TeamFeatureValidateSAMLEmails Features.setValidateSAMLEmailsInternal, - iTeamFeatureStatusValidateSAMLEmailsDeprecatedGet = iGetTeamFeature @'Public.TeamFeatureValidateSAMLEmails Features.getValidateSAMLEmailsInternal, + iTeamFeatureStatusValidateSAMLEmailsDeprecatedGet = iGetTeamFeature @'Public.WithoutPaymentStatus @'Public.TeamFeatureValidateSAMLEmails Features.getValidateSAMLEmailsInternal, iTeamFeatureStatusValidateSAMLEmailsDeprecatedPut = iPutTeamFeature @'Public.TeamFeatureValidateSAMLEmails Features.setValidateSAMLEmailsInternal, - iTeamFeatureStatusDigitalSignaturesGet = iGetTeamFeature @'Public.TeamFeatureDigitalSignatures Features.getDigitalSignaturesInternal, + iTeamFeatureStatusDigitalSignaturesGet = iGetTeamFeature @'Public.WithoutPaymentStatus @'Public.TeamFeatureDigitalSignatures Features.getDigitalSignaturesInternal, iTeamFeatureStatusDigitalSignaturesPut = iPutTeamFeature @'Public.TeamFeatureDigitalSignatures Features.setDigitalSignaturesInternal, - iTeamFeatureStatusDigitalSignaturesDeprecatedGet = iGetTeamFeature @'Public.TeamFeatureDigitalSignatures Features.getDigitalSignaturesInternal, + iTeamFeatureStatusDigitalSignaturesDeprecatedGet = iGetTeamFeature @'Public.WithoutPaymentStatus @'Public.TeamFeatureDigitalSignatures Features.getDigitalSignaturesInternal, iTeamFeatureStatusDigitalSignaturesDeprecatedPut = iPutTeamFeature @'Public.TeamFeatureDigitalSignatures Features.setDigitalSignaturesInternal, - iTeamFeatureStatusAppLockGet = iGetTeamFeature @'Public.TeamFeatureAppLock Features.getAppLockInternal, + iTeamFeatureStatusAppLockGet = iGetTeamFeature @'Public.WithoutPaymentStatus @'Public.TeamFeatureAppLock Features.getAppLockInternal, iTeamFeatureStatusAppLockPut = iPutTeamFeature @'Public.TeamFeatureAppLock Features.setAppLockInternal, - iTeamFeatureStatusFileSharingGet = iGetTeamFeature @'Public.TeamFeatureFileSharing Features.getFileSharingInternal, + iTeamFeatureStatusFileSharingGet = iGetTeamFeature @'Public.WithoutPaymentStatus @'Public.TeamFeatureFileSharing Features.getFileSharingInternal, iTeamFeatureStatusFileSharingPut = iPutTeamFeature @'Public.TeamFeatureFileSharing Features.setFileSharingInternal, - iTeamFeatureStatusClassifiedDomainsGet = iGetTeamFeature @'Public.TeamFeatureClassifiedDomains Features.getClassifiedDomainsInternal, + iTeamFeatureStatusClassifiedDomainsGet = iGetTeamFeature @'Public.WithoutPaymentStatus @'Public.TeamFeatureClassifiedDomains Features.getClassifiedDomainsInternal, iTeamFeatureStatusConferenceCallingPut = iPutTeamFeature @'Public.TeamFeatureConferenceCalling Features.setConferenceCallingInternal, - iTeamFeatureStatusConferenceCallingGet = iGetTeamFeature @'Public.TeamFeatureConferenceCalling Features.getConferenceCallingInternal, + iTeamFeatureStatusConferenceCallingGet = iGetTeamFeature @'Public.WithPaymentStatus @'Public.TeamFeatureConferenceCalling Features.getConferenceCallingInternal, iTeamFeatureStatusSelfDeletingMessagesPut = iPutTeamFeature @'Public.TeamFeatureSelfDeletingMessages Features.setSelfDeletingMessagesInternal, - iTeamFeatureStatusSelfDeletingMessagesGet = iGetTeamFeature @'Public.TeamFeatureSelfDeletingMessages Features.getSelfDeletingMessagesInternal, + iTeamFeatureStatusSelfDeletingMessagesGet = iGetTeamFeature @'Public.WithPaymentStatus @'Public.TeamFeatureSelfDeletingMessages Features.getSelfDeletingMessagesInternal, + iTeamFeaturePaymentStatusSelfDeletingMessagesPut = Features.setPaymentStatus @'Public.TeamFeatureSelfDeletingMessages, + iTeamFeaturePaymentStatusConferenceCallingPut = Features.setPaymentStatus @'Public.TeamFeatureConferenceCalling, iDeleteUser = rmUser, iConnect = Create.createConnectConversation, iUpsertOne2OneConversation = One2One.iUpsertOne2OneConversation } iGetTeamFeature :: - forall a r. + forall ps a r. ( Public.KnownTeamFeatureName a, Members '[ Error ActionError, @@ -319,26 +338,29 @@ iGetTeamFeature :: ] r ) => - (Features.GetFeatureInternalParam -> Sem r (Public.TeamFeatureStatus a)) -> + (Features.GetFeatureInternalParam -> Sem r (Public.TeamFeatureStatus ps a)) -> TeamId -> - Sem r (Public.TeamFeatureStatus a) -iGetTeamFeature getter = Features.getFeatureStatus @a getter DontDoAuth + Sem r (Public.TeamFeatureStatus ps a) +iGetTeamFeature getter = Features.getFeatureStatus @ps @a getter DontDoAuth iPutTeamFeature :: forall a r. ( Public.KnownTeamFeatureName a, + MaybeHasPaymentStatusCol a, Members '[ Error ActionError, Error NotATeamMember, Error TeamError, - TeamStore + Error TeamFeatureError, + TeamStore, + TeamFeatureStore ] r ) => - (TeamId -> Public.TeamFeatureStatus a -> Sem r (Public.TeamFeatureStatus a)) -> + (TeamId -> Public.TeamFeatureStatus 'Public.WithoutPaymentStatus a -> Sem r (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus a)) -> TeamId -> - Public.TeamFeatureStatus a -> - Sem r (Public.TeamFeatureStatus a) + Public.TeamFeatureStatus 'Public.WithoutPaymentStatus a -> + Sem r (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus a) iPutTeamFeature setter = Features.setFeatureStatus @a setter DontDoAuth sitemap :: Routes a (Sem GalleyEffects) () @@ -581,7 +603,7 @@ rmUser lusr conn = do for_ (maybeList1 (catMaybes pp)) - (push) + push -- FUTUREWORK: This could be optimized to reduce the number of RPCs -- made. When a team is deleted the burst of RPCs created here could diff --git a/services/galley/src/Galley/API/LegalHold.hs b/services/galley/src/Galley/API/LegalHold.hs index 5bbe62a236..4445111760 100644 --- a/services/galley/src/Galley/API/LegalHold.hs +++ b/services/galley/src/Galley/API/LegalHold.hs @@ -103,7 +103,7 @@ isLegalHoldEnabledForTeam tid = do pure False FeatureLegalHoldDisabledByDefault -> do statusValue <- - Public.tfwoStatus <$$> TeamFeatures.getFeatureStatusNoConfig @'Public.TeamFeatureLegalHold tid + (Public.tfwoStatus . \(fst,_)-> fst) <$$> TeamFeatures.getFeatureStatusNoConfig @'Public.TeamFeatureLegalHold tid return $ case statusValue of Just Public.TeamFeatureEnabled -> True Just Public.TeamFeatureDisabled -> False diff --git a/services/galley/src/Galley/API/Public.hs b/services/galley/src/Galley/API/Public.hs index 3027ba070a..7f58c32265 100644 --- a/services/galley/src/Galley/API/Public.hs +++ b/services/galley/src/Galley/API/Public.hs @@ -117,70 +117,70 @@ servantSitemap = GalleyAPI.postOtrMessageUnqualified = Update.postOtrMessageUnqualified, GalleyAPI.postProteusMessage = Update.postProteusMessage, GalleyAPI.teamFeatureStatusSSOGet = - getFeatureStatus @'Public.TeamFeatureSSO Features.getSSOStatusInternal + getFeatureStatus @'Public.WithoutPaymentStatus @'Public.TeamFeatureSSO Features.getSSOStatusInternal . DoAuth, GalleyAPI.teamFeatureStatusLegalHoldGet = - getFeatureStatus @'Public.TeamFeatureLegalHold Features.getLegalholdStatusInternal + getFeatureStatus @'Public.WithoutPaymentStatus @'Public.TeamFeatureLegalHold Features.getLegalholdStatusInternal . DoAuth, GalleyAPI.teamFeatureStatusLegalHoldPut = setFeatureStatus @'Public.TeamFeatureLegalHold (Features.setLegalholdStatusInternal @InternalPaging) . DoAuth, GalleyAPI.teamFeatureStatusSearchVisibilityGet = - getFeatureStatus @'Public.TeamFeatureSearchVisibility Features.getTeamSearchVisibilityAvailableInternal + getFeatureStatus @'Public.WithoutPaymentStatus @'Public.TeamFeatureSearchVisibility Features.getTeamSearchVisibilityAvailableInternal . DoAuth, GalleyAPI.teamFeatureStatusSearchVisibilityPut = setFeatureStatus @'Public.TeamFeatureSearchVisibility Features.setTeamSearchVisibilityAvailableInternal . DoAuth, GalleyAPI.teamFeatureStatusSearchVisibilityDeprecatedGet = - getFeatureStatus @'Public.TeamFeatureSearchVisibility Features.getTeamSearchVisibilityAvailableInternal + getFeatureStatus @'Public.WithoutPaymentStatus @'Public.TeamFeatureSearchVisibility Features.getTeamSearchVisibilityAvailableInternal . DoAuth, GalleyAPI.teamFeatureStatusSearchVisibilityDeprecatedPut = setFeatureStatus @'Public.TeamFeatureSearchVisibility Features.setTeamSearchVisibilityAvailableInternal . DoAuth, GalleyAPI.teamFeatureStatusValidateSAMLEmailsGet = - getFeatureStatus @'Public.TeamFeatureValidateSAMLEmails Features.getValidateSAMLEmailsInternal + getFeatureStatus @'Public.WithoutPaymentStatus @'Public.TeamFeatureValidateSAMLEmails Features.getValidateSAMLEmailsInternal . DoAuth, GalleyAPI.teamFeatureStatusValidateSAMLEmailsDeprecatedGet = - getFeatureStatus @'Public.TeamFeatureValidateSAMLEmails Features.getValidateSAMLEmailsInternal + getFeatureStatus @'Public.WithoutPaymentStatus @'Public.TeamFeatureValidateSAMLEmails Features.getValidateSAMLEmailsInternal . DoAuth, GalleyAPI.teamFeatureStatusDigitalSignaturesGet = - getFeatureStatus @'Public.TeamFeatureDigitalSignatures Features.getDigitalSignaturesInternal + getFeatureStatus @'Public.WithoutPaymentStatus @'Public.TeamFeatureDigitalSignatures Features.getDigitalSignaturesInternal . DoAuth, GalleyAPI.teamFeatureStatusDigitalSignaturesDeprecatedGet = - getFeatureStatus @'Public.TeamFeatureDigitalSignatures Features.getDigitalSignaturesInternal + getFeatureStatus @'Public.WithoutPaymentStatus @'Public.TeamFeatureDigitalSignatures Features.getDigitalSignaturesInternal . DoAuth, GalleyAPI.teamFeatureStatusAppLockGet = - getFeatureStatus @'Public.TeamFeatureAppLock Features.getAppLockInternal + getFeatureStatus @'Public.WithoutPaymentStatus @'Public.TeamFeatureAppLock Features.getAppLockInternal . DoAuth, GalleyAPI.teamFeatureStatusAppLockPut = setFeatureStatus @'Public.TeamFeatureAppLock Features.setAppLockInternal . DoAuth, GalleyAPI.teamFeatureStatusFileSharingGet = - getFeatureStatus @'Public.TeamFeatureFileSharing Features.getFileSharingInternal . DoAuth, + getFeatureStatus @'Public.WithoutPaymentStatus @'Public.TeamFeatureFileSharing Features.getFileSharingInternal . DoAuth, GalleyAPI.teamFeatureStatusFileSharingPut = setFeatureStatus @'Public.TeamFeatureFileSharing Features.setFileSharingInternal . DoAuth, GalleyAPI.teamFeatureStatusClassifiedDomainsGet = - getFeatureStatus @'Public.TeamFeatureClassifiedDomains Features.getClassifiedDomainsInternal + getFeatureStatus @'Public.WithoutPaymentStatus @'Public.TeamFeatureClassifiedDomains Features.getClassifiedDomainsInternal . DoAuth, GalleyAPI.teamFeatureStatusConferenceCallingGet = - getFeatureStatus @'Public.TeamFeatureConferenceCalling Features.getConferenceCallingInternal + getFeatureStatus @'Public.WithPaymentStatus @'Public.TeamFeatureConferenceCalling Features.getConferenceCallingInternal . DoAuth, GalleyAPI.teamFeatureStatusSelfDeletingMessagesGet = - getFeatureStatus @'Public.TeamFeatureSelfDeletingMessages Features.getSelfDeletingMessagesInternal + getFeatureStatus @'Public.WithPaymentStatus @'Public.TeamFeatureSelfDeletingMessages Features.getSelfDeletingMessagesInternal . DoAuth, GalleyAPI.teamFeatureStatusSelfDeletingMessagesPut = setFeatureStatus @'Public.TeamFeatureSelfDeletingMessages Features.setSelfDeletingMessagesInternal . DoAuth, GalleyAPI.featureAllFeatureConfigsGet = Features.getAllFeatureConfigs, - GalleyAPI.featureConfigLegalHoldGet = Features.getFeatureConfig @'Public.TeamFeatureLegalHold Features.getLegalholdStatusInternal, - GalleyAPI.featureConfigSSOGet = Features.getFeatureConfig @'Public.TeamFeatureSSO Features.getSSOStatusInternal, - GalleyAPI.featureConfigSearchVisibilityGet = Features.getFeatureConfig @'Public.TeamFeatureSearchVisibility Features.getTeamSearchVisibilityAvailableInternal, - GalleyAPI.featureConfigValidateSAMLEmailsGet = Features.getFeatureConfig @'Public.TeamFeatureValidateSAMLEmails Features.getValidateSAMLEmailsInternal, - GalleyAPI.featureConfigDigitalSignaturesGet = Features.getFeatureConfig @'Public.TeamFeatureDigitalSignatures Features.getDigitalSignaturesInternal, - GalleyAPI.featureConfigAppLockGet = Features.getFeatureConfig @'Public.TeamFeatureAppLock Features.getAppLockInternal, - GalleyAPI.featureConfigFileSharingGet = Features.getFeatureConfig @'Public.TeamFeatureFileSharing Features.getFileSharingInternal, - GalleyAPI.featureConfigClassifiedDomainsGet = Features.getFeatureConfig @'Public.TeamFeatureClassifiedDomains Features.getClassifiedDomainsInternal, - GalleyAPI.featureConfigConferenceCallingGet = Features.getFeatureConfig @'Public.TeamFeatureConferenceCalling Features.getConferenceCallingInternal, - GalleyAPI.featureConfigSelfDeletingMessagesGet = Features.getFeatureConfig @'Public.TeamFeatureSelfDeletingMessages Features.getSelfDeletingMessagesInternal + GalleyAPI.featureConfigLegalHoldGet = Features.getFeatureConfig @'Public.WithoutPaymentStatus @'Public.TeamFeatureLegalHold Features.getLegalholdStatusInternal, + GalleyAPI.featureConfigSSOGet = Features.getFeatureConfig @'Public.WithoutPaymentStatus @'Public.TeamFeatureSSO Features.getSSOStatusInternal, + GalleyAPI.featureConfigSearchVisibilityGet = Features.getFeatureConfig @'Public.WithoutPaymentStatus @'Public.TeamFeatureSearchVisibility Features.getTeamSearchVisibilityAvailableInternal, + GalleyAPI.featureConfigValidateSAMLEmailsGet = Features.getFeatureConfig @'Public.WithoutPaymentStatus @'Public.TeamFeatureValidateSAMLEmails Features.getValidateSAMLEmailsInternal, + GalleyAPI.featureConfigDigitalSignaturesGet = Features.getFeatureConfig @'Public.WithoutPaymentStatus @'Public.TeamFeatureDigitalSignatures Features.getDigitalSignaturesInternal, + GalleyAPI.featureConfigAppLockGet = Features.getFeatureConfig @'Public.WithoutPaymentStatus @'Public.TeamFeatureAppLock Features.getAppLockInternal, + GalleyAPI.featureConfigFileSharingGet = Features.getFeatureConfig @'Public.WithoutPaymentStatus @'Public.TeamFeatureFileSharing Features.getFileSharingInternal, + GalleyAPI.featureConfigClassifiedDomainsGet = Features.getFeatureConfig @'Public.WithoutPaymentStatus @'Public.TeamFeatureClassifiedDomains Features.getClassifiedDomainsInternal, + GalleyAPI.featureConfigConferenceCallingGet = Features.getFeatureConfig @'Public.WithPaymentStatus @'Public.TeamFeatureConferenceCalling Features.getConferenceCallingInternal, + GalleyAPI.featureConfigSelfDeletingMessagesGet = Features.getFeatureConfig @'Public.WithPaymentStatus @'Public.TeamFeatureSelfDeletingMessages Features.getSelfDeletingMessagesInternal } sitemap :: Routes ApiBuilder (Sem GalleyEffects) () diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index ce9b1ef65b..ab74d16933 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -1522,7 +1522,7 @@ canUserJoinTeam tid = do getTeamSearchVisibilityAvailableInternal :: Members '[Input Opts, TeamFeatureStore] r => TeamId -> - Sem r (Public.TeamFeatureStatus 'Public.TeamFeatureSearchVisibility) + Sem r (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus 'Public.TeamFeatureSearchVisibility) getTeamSearchVisibilityAvailableInternal tid = do -- TODO: This is just redundant given there is a decent default defConfig <- do diff --git a/services/galley/src/Galley/API/Teams/Features.hs b/services/galley/src/Galley/API/Teams/Features.hs index 19e49f76b1..9c0c12e0e4 100644 --- a/services/galley/src/Galley/API/Teams/Features.hs +++ b/services/galley/src/Galley/API/Teams/Features.hs @@ -40,6 +40,7 @@ module Galley.API.Teams.Features setConferenceCallingInternal, getSelfDeletingMessagesInternal, setSelfDeletingMessagesInternal, + setPaymentStatus, DoAuth (..), GetFeatureInternalParam, ) @@ -90,7 +91,7 @@ data DoAuth = DoAuth UserId | DontDoAuth -- | For team-settings, to administrate team feature configuration. Here we have an admin uid -- and a team id, but no uid of the member for which the feature config holds. getFeatureStatus :: - forall (a :: Public.TeamFeatureName) r. + forall (ps :: Public.IncludePaymentStatus) (a :: Public.TeamFeatureName) r. ( Public.KnownTeamFeatureName a, Members '[ Error ActionError, @@ -100,10 +101,10 @@ getFeatureStatus :: ] r ) => - (GetFeatureInternalParam -> Sem r (Public.TeamFeatureStatus a)) -> + (GetFeatureInternalParam -> Sem r (Public.TeamFeatureStatus ps a)) -> DoAuth -> TeamId -> - Sem r (Public.TeamFeatureStatus a) + Sem r (Public.TeamFeatureStatus ps a) getFeatureStatus getter doauth tid = do case doauth of DoAuth uid -> do @@ -117,19 +118,21 @@ getFeatureStatus getter doauth tid = do setFeatureStatus :: forall (a :: Public.TeamFeatureName) r. ( Public.KnownTeamFeatureName a, + MaybeHasPaymentStatusCol a, Members '[ Error ActionError, Error TeamError, Error NotATeamMember, - TeamStore + TeamStore, + TeamFeatureStore ] r ) => - (TeamId -> Public.TeamFeatureStatus a -> Sem r (Public.TeamFeatureStatus a)) -> + (TeamId -> Public.TeamFeatureStatus 'Public.WithoutPaymentStatus a -> Sem r (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus a)) -> DoAuth -> TeamId -> - Public.TeamFeatureStatus a -> - Sem r (Public.TeamFeatureStatus a) + Public.TeamFeatureStatus 'Public.WithoutPaymentStatus a -> + Sem r (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus a) setFeatureStatus setter doauth tid status = do case doauth of DoAuth uid -> do @@ -139,9 +142,30 @@ setFeatureStatus setter doauth tid status = do assertTeamExists tid setter tid status +-- | Setting payment status can only be done through the internal API and therefore doesn't require auth. +setPaymentStatus :: + forall (a :: Public.TeamFeatureName) r. + ( Public.KnownTeamFeatureName a, + HasPaymentStatusCol a, + Members + [ Error ActionError, + Error TeamError, + Error NotATeamMember, + TeamStore, + TeamFeatureStore + ] + r + ) => + TeamId -> + Public.PaymentStatusValue -> + Sem r Public.PaymentStatus +setPaymentStatus tid paymentStatusUpdate = do + assertTeamExists tid + TeamFeatures.setPaymentStatus @a tid (Public.PaymentStatus paymentStatusUpdate) + -- | For individual users to get feature config for their account (personal or team). getFeatureConfig :: - forall (a :: Public.TeamFeatureName) r. + forall (ps :: Public.IncludePaymentStatus) (a :: Public.TeamFeatureName) r. ( Public.KnownTeamFeatureName a, Members '[ Error ActionError, @@ -151,9 +175,9 @@ getFeatureConfig :: ] r ) => - (GetFeatureInternalParam -> Sem r (Public.TeamFeatureStatus a)) -> + (GetFeatureInternalParam -> Sem r (Public.TeamFeatureStatus ps a)) -> UserId -> - Sem r (Public.TeamFeatureStatus a) + Sem r (Public.TeamFeatureStatus ps a) getFeatureConfig getter zusr = do mbTeam <- getOneUserTeam zusr case mbTeam of @@ -180,34 +204,34 @@ getAllFeatureConfigs :: Sem r AllFeatureConfigs getAllFeatureConfigs zusr = do mbTeam <- getOneUserTeam zusr - zusrMembership <- maybe (pure Nothing) ((flip getTeamMember zusr)) mbTeam + zusrMembership <- maybe (pure Nothing) (flip getTeamMember zusr) mbTeam let getStatus :: - forall (a :: Public.TeamFeatureName) r. + forall (ps :: Public.IncludePaymentStatus) (a :: Public.TeamFeatureName) r. ( Public.KnownTeamFeatureName a, - Aeson.ToJSON (Public.TeamFeatureStatus a), + Aeson.ToJSON (Public.TeamFeatureStatus ps a), Members '[Error ActionError, Error TeamError, Error NotATeamMember, TeamStore] r ) => - (GetFeatureInternalParam -> Sem r (Public.TeamFeatureStatus a)) -> + (GetFeatureInternalParam -> Sem r (Public.TeamFeatureStatus ps a)) -> Sem r (Text, Aeson.Value) getStatus getter = do when (isJust mbTeam) $ do void $ permissionCheck (ViewTeamFeature (Public.knownTeamFeatureName @a)) zusrMembership status <- getter (maybe (Left (Just zusr)) Right mbTeam) let feature = Public.knownTeamFeatureName @a - pure $ (cs (toByteString' feature) Aeson..= status) + pure $ cs (toByteString' feature) Aeson..= status AllFeatureConfigs . HashMap.fromList <$> sequence - [ getStatus @'Public.TeamFeatureLegalHold getLegalholdStatusInternal, - getStatus @'Public.TeamFeatureSSO getSSOStatusInternal, - getStatus @'Public.TeamFeatureSearchVisibility getTeamSearchVisibilityAvailableInternal, - getStatus @'Public.TeamFeatureValidateSAMLEmails getValidateSAMLEmailsInternal, - getStatus @'Public.TeamFeatureDigitalSignatures getDigitalSignaturesInternal, - getStatus @'Public.TeamFeatureAppLock getAppLockInternal, - getStatus @'Public.TeamFeatureFileSharing getFileSharingInternal, - getStatus @'Public.TeamFeatureClassifiedDomains getClassifiedDomainsInternal, - getStatus @'Public.TeamFeatureConferenceCalling getConferenceCallingInternal, - getStatus @'Public.TeamFeatureSelfDeletingMessages getSelfDeletingMessagesInternal + [ getStatus @'Public.WithoutPaymentStatus @'Public.TeamFeatureLegalHold getLegalholdStatusInternal, + getStatus @'Public.WithoutPaymentStatus @'Public.TeamFeatureSSO getSSOStatusInternal, + getStatus @'Public.WithoutPaymentStatus @'Public.TeamFeatureSearchVisibility getTeamSearchVisibilityAvailableInternal, + getStatus @'Public.WithoutPaymentStatus @'Public.TeamFeatureValidateSAMLEmails getValidateSAMLEmailsInternal, + getStatus @'Public.WithoutPaymentStatus @'Public.TeamFeatureDigitalSignatures getDigitalSignaturesInternal, + getStatus @'Public.WithoutPaymentStatus @'Public.TeamFeatureAppLock getAppLockInternal, + getStatus @'Public.WithoutPaymentStatus @'Public.TeamFeatureFileSharing getFileSharingInternal, + getStatus @'Public.WithoutPaymentStatus @'Public.TeamFeatureClassifiedDomains getClassifiedDomainsInternal, + getStatus @'Public.WithPaymentStatus @'Public.TeamFeatureConferenceCalling getConferenceCallingInternal, + getStatus @'Public.WithPaymentStatus @'Public.TeamFeatureSelfDeletingMessages getSelfDeletingMessagesInternal ] getAllFeaturesH :: @@ -246,39 +270,39 @@ getAllFeatures :: getAllFeatures uid tid = do Aeson.object <$> sequence - [ getStatus @'Public.TeamFeatureSSO getSSOStatusInternal, - getStatus @'Public.TeamFeatureLegalHold getLegalholdStatusInternal, - getStatus @'Public.TeamFeatureSearchVisibility getTeamSearchVisibilityAvailableInternal, - getStatus @'Public.TeamFeatureValidateSAMLEmails getValidateSAMLEmailsInternal, - getStatus @'Public.TeamFeatureDigitalSignatures getDigitalSignaturesInternal, - getStatus @'Public.TeamFeatureAppLock getAppLockInternal, - getStatus @'Public.TeamFeatureFileSharing getFileSharingInternal, - getStatus @'Public.TeamFeatureClassifiedDomains getClassifiedDomainsInternal, - getStatus @'Public.TeamFeatureConferenceCalling getConferenceCallingInternal, - getStatus @'Public.TeamFeatureSelfDeletingMessages getSelfDeletingMessagesInternal + [ getStatus @'Public.WithoutPaymentStatus @'Public.TeamFeatureSSO getSSOStatusInternal, + getStatus @'Public.WithoutPaymentStatus @'Public.TeamFeatureLegalHold getLegalholdStatusInternal, + getStatus @'Public.WithoutPaymentStatus @'Public.TeamFeatureSearchVisibility getTeamSearchVisibilityAvailableInternal, + getStatus @'Public.WithoutPaymentStatus @'Public.TeamFeatureValidateSAMLEmails getValidateSAMLEmailsInternal, + getStatus @'Public.WithoutPaymentStatus @'Public.TeamFeatureDigitalSignatures getDigitalSignaturesInternal, + getStatus @'Public.WithoutPaymentStatus @'Public.TeamFeatureAppLock getAppLockInternal, + getStatus @'Public.WithoutPaymentStatus @'Public.TeamFeatureFileSharing getFileSharingInternal, + getStatus @'Public.WithoutPaymentStatus @'Public.TeamFeatureClassifiedDomains getClassifiedDomainsInternal, + getStatus @'Public.WithPaymentStatus @'Public.TeamFeatureConferenceCalling getConferenceCallingInternal, + getStatus @'Public.WithPaymentStatus @'Public.TeamFeatureSelfDeletingMessages getSelfDeletingMessagesInternal ] where getStatus :: - forall (a :: Public.TeamFeatureName). + forall (ps :: Public.IncludePaymentStatus) (a :: Public.TeamFeatureName). ( Public.KnownTeamFeatureName a, - Aeson.ToJSON (Public.TeamFeatureStatus a) + Aeson.ToJSON (Public.TeamFeatureStatus ps a) ) => - (GetFeatureInternalParam -> Sem r (Public.TeamFeatureStatus a)) -> + (GetFeatureInternalParam -> Sem r (Public.TeamFeatureStatus ps a)) -> Sem r (Text, Aeson.Value) getStatus getter = do - status <- getFeatureStatus @a getter (DoAuth uid) tid + status <- getFeatureStatus @ps @a getter (DoAuth uid) tid let feature = Public.knownTeamFeatureName @a - pure $ (cs (toByteString' feature) Aeson..= status) + pure $ cs (toByteString' feature) Aeson..= status getFeatureStatusNoConfig :: forall (a :: Public.TeamFeatureName) r. - ( Public.FeatureHasNoConfig a, + ( Public.FeatureHasNoConfig 'Public.WithoutPaymentStatus a, HasStatusCol a, Member TeamFeatureStore r ) => Sem r Public.TeamFeatureStatusValue -> TeamId -> - Sem r (Public.TeamFeatureStatus a) + Sem r (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus a) getFeatureStatusNoConfig getDefault tid = do defaultStatus <- Public.TeamFeatureStatusNoConfig <$> getDefault fromMaybe defaultStatus <$> TeamFeatures.getFeatureStatusNoConfig @a tid @@ -286,14 +310,14 @@ getFeatureStatusNoConfig getDefault tid = do setFeatureStatusNoConfig :: forall (a :: Public.TeamFeatureName) r. ( Public.KnownTeamFeatureName a, - Public.FeatureHasNoConfig a, + Public.FeatureHasNoConfig 'Public.WithoutPaymentStatus a, HasStatusCol a, Members '[GundeckAccess, TeamFeatureStore, TeamStore, P.TinyLog] r ) => (Public.TeamFeatureStatusValue -> TeamId -> Sem r ()) -> TeamId -> - Public.TeamFeatureStatus a -> - Sem r (Public.TeamFeatureStatus a) + Public.TeamFeatureStatus 'Public.WithoutPaymentStatus a -> + Sem r (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus a) setFeatureStatusNoConfig applyState tid status = do applyState (Public.tfwoStatus status) tid newStatus <- TeamFeatures.setFeatureStatusNoConfig @a tid status @@ -308,7 +332,7 @@ type GetFeatureInternalParam = Either (Maybe UserId) TeamId getSSOStatusInternal :: Members '[Input Opts, TeamFeatureStore] r => GetFeatureInternalParam -> - Sem r (Public.TeamFeatureStatus 'Public.TeamFeatureSSO) + Sem r (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus 'Public.TeamFeatureSSO) getSSOStatusInternal = either (const $ Public.TeamFeatureStatusNoConfig <$> getDef) @@ -323,8 +347,8 @@ getSSOStatusInternal = setSSOStatusInternal :: Members '[Error TeamFeatureError, GundeckAccess, TeamFeatureStore, TeamStore, P.TinyLog] r => TeamId -> - (Public.TeamFeatureStatus 'Public.TeamFeatureSSO) -> - Sem r (Public.TeamFeatureStatus 'Public.TeamFeatureSSO) + Public.TeamFeatureStatus 'Public.WithoutPaymentStatus 'Public.TeamFeatureSSO -> + Sem r (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus 'Public.TeamFeatureSSO) setSSOStatusInternal = setFeatureStatusNoConfig @'Public.TeamFeatureSSO $ \case Public.TeamFeatureDisabled -> const (throw DisableSsoNotImplemented) Public.TeamFeatureEnabled -> const (pure ()) @@ -332,7 +356,7 @@ setSSOStatusInternal = setFeatureStatusNoConfig @'Public.TeamFeatureSSO $ \case getTeamSearchVisibilityAvailableInternal :: Members '[Input Opts, TeamFeatureStore] r => GetFeatureInternalParam -> - Sem r (Public.TeamFeatureStatus 'Public.TeamFeatureSearchVisibility) + Sem r (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus 'Public.TeamFeatureSearchVisibility) getTeamSearchVisibilityAvailableInternal = either (const $ Public.TeamFeatureStatusNoConfig <$> getDef) @@ -346,8 +370,8 @@ getTeamSearchVisibilityAvailableInternal = setTeamSearchVisibilityAvailableInternal :: Members '[GundeckAccess, SearchVisibilityStore, TeamFeatureStore, TeamStore, P.TinyLog] r => TeamId -> - (Public.TeamFeatureStatus 'Public.TeamFeatureSearchVisibility) -> - Sem r (Public.TeamFeatureStatus 'Public.TeamFeatureSearchVisibility) + Public.TeamFeatureStatus 'Public.WithoutPaymentStatus 'Public.TeamFeatureSearchVisibility -> + Sem r (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus 'Public.TeamFeatureSearchVisibility) setTeamSearchVisibilityAvailableInternal = setFeatureStatusNoConfig @'Public.TeamFeatureSearchVisibility $ \case Public.TeamFeatureDisabled -> SearchVisibilityData.resetSearchVisibility Public.TeamFeatureEnabled -> const (pure ()) @@ -355,11 +379,11 @@ setTeamSearchVisibilityAvailableInternal = setFeatureStatusNoConfig @'Public.Tea getValidateSAMLEmailsInternal :: Member TeamFeatureStore r => GetFeatureInternalParam -> - Sem r (Public.TeamFeatureStatus 'Public.TeamFeatureValidateSAMLEmails) + Sem r (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus 'Public.TeamFeatureValidateSAMLEmails) getValidateSAMLEmailsInternal = either (const $ Public.TeamFeatureStatusNoConfig <$> getDef) - (getFeatureStatusNoConfig @'Public.TeamFeatureValidateSAMLEmails getDef) + (getFeatureStatusNoConfig @'Public.TeamFeatureValidateSAMLEmails getDef) where -- FUTUREWORK: we may also want to get a default from the server config file here, like for -- sso, and team search visibility. @@ -369,14 +393,14 @@ getValidateSAMLEmailsInternal = setValidateSAMLEmailsInternal :: Members '[GundeckAccess, TeamFeatureStore, TeamStore, P.TinyLog] r => TeamId -> - (Public.TeamFeatureStatus 'Public.TeamFeatureValidateSAMLEmails) -> - Sem r (Public.TeamFeatureStatus 'Public.TeamFeatureValidateSAMLEmails) + Public.TeamFeatureStatus 'Public.WithoutPaymentStatus 'Public.TeamFeatureValidateSAMLEmails -> + Sem r (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus 'Public.TeamFeatureValidateSAMLEmails) setValidateSAMLEmailsInternal = setFeatureStatusNoConfig @'Public.TeamFeatureValidateSAMLEmails $ \_ _ -> pure () getDigitalSignaturesInternal :: Member TeamFeatureStore r => GetFeatureInternalParam -> - Sem r (Public.TeamFeatureStatus 'Public.TeamFeatureDigitalSignatures) + Sem r (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus 'Public.TeamFeatureDigitalSignatures) getDigitalSignaturesInternal = either (const $ Public.TeamFeatureStatusNoConfig <$> getDef) @@ -390,14 +414,14 @@ getDigitalSignaturesInternal = setDigitalSignaturesInternal :: Members '[GundeckAccess, TeamFeatureStore, TeamStore, P.TinyLog] r => TeamId -> - Public.TeamFeatureStatus 'Public.TeamFeatureDigitalSignatures -> - Sem r (Public.TeamFeatureStatus 'Public.TeamFeatureDigitalSignatures) -setDigitalSignaturesInternal = setFeatureStatusNoConfig @'Public.TeamFeatureDigitalSignatures $ \_ _ -> pure () + Public.TeamFeatureStatus 'Public.WithoutPaymentStatus 'Public.TeamFeatureDigitalSignatures -> + Sem r (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus 'Public.TeamFeatureDigitalSignatures) +setDigitalSignaturesInternal = setFeatureStatusNoConfig @'Public.TeamFeatureDigitalSignatures $ \_ _ -> pure () getLegalholdStatusInternal :: Members '[LegalHoldStore, TeamFeatureStore, TeamStore] r => GetFeatureInternalParam -> - Sem r (Public.TeamFeatureStatus 'Public.TeamFeatureLegalHold) + Sem r (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus 'Public.TeamFeatureLegalHold) getLegalholdStatusInternal (Left _) = pure $ Public.TeamFeatureStatusNoConfig Public.TeamFeatureDisabled getLegalholdStatusInternal (Right tid) = do @@ -440,8 +464,8 @@ setLegalholdStatusInternal :: r ) => TeamId -> - Public.TeamFeatureStatus 'Public.TeamFeatureLegalHold -> - Sem r (Public.TeamFeatureStatus 'Public.TeamFeatureLegalHold) + Public.TeamFeatureStatus 'Public.WithoutPaymentStatus 'Public.TeamFeatureLegalHold -> + Sem r (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus 'Public.TeamFeatureLegalHold) setLegalholdStatusInternal tid status@(Public.tfwoStatus -> statusValue) = do do -- this extra do is to encapsulate the assertions running before the actual operation. @@ -461,12 +485,12 @@ setLegalholdStatusInternal tid status@(Public.tfwoStatus -> statusValue) = do Public.TeamFeatureDisabled -> removeSettings' @p tid Public.TeamFeatureEnabled -> do ensureNotTooLargeToActivateLegalHold tid - TeamFeatures.setFeatureStatusNoConfig @'Public.TeamFeatureLegalHold tid status + TeamFeatures.setFeatureStatusNoConfig @'Public.TeamFeatureLegalHold tid status getFileSharingInternal :: Members '[Input Opts, TeamFeatureStore] r => GetFeatureInternalParam -> - Sem r (Public.TeamFeatureStatus 'Public.TeamFeatureFileSharing) + Sem r (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus 'Public.TeamFeatureFileSharing) getFileSharingInternal = getFeatureStatusWithDefaultConfig @'Public.TeamFeatureFileSharing flagFileSharing . either (const Nothing) Just @@ -474,12 +498,12 @@ getFeatureStatusWithDefaultConfig :: forall (a :: TeamFeatureName) r. ( KnownTeamFeatureName a, HasStatusCol a, - FeatureHasNoConfig a, + FeatureHasNoConfig 'Public.WithoutPaymentStatus a, Members '[Input Opts, TeamFeatureStore] r ) => - Lens' FeatureFlags (Defaults (Public.TeamFeatureStatus a)) -> + Lens' FeatureFlags (Defaults (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus a)) -> Maybe TeamId -> - Sem r (Public.TeamFeatureStatus a) + Sem r (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus a) getFeatureStatusWithDefaultConfig lens' = maybe (Public.TeamFeatureStatusNoConfig <$> getDef) @@ -493,14 +517,14 @@ getFeatureStatusWithDefaultConfig lens' = setFileSharingInternal :: Members '[GundeckAccess, TeamFeatureStore, TeamStore, P.TinyLog] r => TeamId -> - Public.TeamFeatureStatus 'Public.TeamFeatureFileSharing -> - Sem r (Public.TeamFeatureStatus 'Public.TeamFeatureFileSharing) -setFileSharingInternal = setFeatureStatusNoConfig @'Public.TeamFeatureFileSharing $ \_status _tid -> pure () + Public.TeamFeatureStatus 'Public.WithoutPaymentStatus 'Public.TeamFeatureFileSharing -> + Sem r (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus 'Public.TeamFeatureFileSharing) +setFileSharingInternal = setFeatureStatusNoConfig @'Public.TeamFeatureFileSharing $ \_status _tid -> pure () getAppLockInternal :: Members '[Input Opts, TeamFeatureStore] r => GetFeatureInternalParam -> - Sem r (Public.TeamFeatureStatus 'Public.TeamFeatureAppLock) + Sem r (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus 'Public.TeamFeatureAppLock) getAppLockInternal mbtid = do Defaults defaultStatus <- inputs (view (optSettings . setFeatureFlags . flagAppLockDefaults)) status <- @@ -510,67 +534,101 @@ getAppLockInternal mbtid = do setAppLockInternal :: Members '[GundeckAccess, TeamFeatureStore, TeamStore, Error TeamFeatureError, P.TinyLog] r => TeamId -> - Public.TeamFeatureStatus 'Public.TeamFeatureAppLock -> - Sem r (Public.TeamFeatureStatus 'Public.TeamFeatureAppLock) + Public.TeamFeatureStatus 'Public.WithoutPaymentStatus 'Public.TeamFeatureAppLock -> + Sem r (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus 'Public.TeamFeatureAppLock) setAppLockInternal tid status = do when (Public.applockInactivityTimeoutSecs (Public.tfwcConfig status) < 30) $ throw AppLockinactivityTimeoutTooLow let pushEvent = pushFeatureConfigEvent tid $ Event.Event Event.Update Public.TeamFeatureAppLock (EdFeatureApplockChanged status) - (TeamFeatures.setApplockFeatureStatus tid status) <* pushEvent + TeamFeatures.setApplockFeatureStatus tid status <* pushEvent getClassifiedDomainsInternal :: Member (Input Opts) r => GetFeatureInternalParam -> - Sem r (Public.TeamFeatureStatus 'Public.TeamFeatureClassifiedDomains) + Sem r (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus 'Public.TeamFeatureClassifiedDomains) getClassifiedDomainsInternal _mbtid = do globalConfig <- inputs (view (optSettings . setFeatureFlags . flagClassifiedDomains)) let config = globalConfig pure $ case Public.tfwcStatus config of - Public.TeamFeatureDisabled -> - Public.TeamFeatureStatusWithConfig Public.TeamFeatureDisabled (Public.TeamFeatureClassifiedDomainsConfig []) + Public.TeamFeatureDisabled -> Public.defaultClassifiedDomains Public.TeamFeatureEnabled -> config getConferenceCallingInternal :: Members '[BrigAccess, Input Opts, TeamFeatureStore] r => GetFeatureInternalParam -> - Sem r (Public.TeamFeatureStatus 'Public.TeamFeatureConferenceCalling) + Sem r (Public.TeamFeatureStatus 'Public.WithPaymentStatus 'Public.TeamFeatureConferenceCalling) getConferenceCallingInternal (Left (Just uid)) = do - getFeatureConfigViaAccount @'Public.TeamFeatureConferenceCalling uid + -- getFeatureConfigViaAccount @'Public.TeamFeatureConferenceCalling uid + error "todo" getConferenceCallingInternal (Left Nothing) = do - getFeatureStatusWithDefaultConfig @'Public.TeamFeatureConferenceCalling flagConferenceCalling Nothing + -- getFeatureStatusWithDefaultConfig @'Public.TeamFeatureConferenceCalling flagConferenceCalling Nothing + error "todo" getConferenceCallingInternal (Right tid) = do - getFeatureStatusWithDefaultConfig @'Public.TeamFeatureConferenceCalling flagConferenceCalling (Just tid) + -- getFeatureStatusWithDefaultConfig @'Public.TeamFeatureConferenceCalling flagConferenceCalling (Just tid) + error "todo" setConferenceCallingInternal :: Members '[GundeckAccess, TeamFeatureStore, TeamStore, P.TinyLog] r => TeamId -> - Public.TeamFeatureStatus 'Public.TeamFeatureConferenceCalling -> - Sem r (Public.TeamFeatureStatus 'Public.TeamFeatureConferenceCalling) + Public.TeamFeatureStatus 'Public.WithoutPaymentStatus 'Public.TeamFeatureConferenceCalling -> + Sem r (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus 'Public.TeamFeatureConferenceCalling) setConferenceCallingInternal = - setFeatureStatusNoConfig @'Public.TeamFeatureConferenceCalling $ \_status _tid -> pure () + setFeatureStatusNoConfig @'Public.TeamFeatureConferenceCalling $ \_status _tid -> pure () getSelfDeletingMessagesInternal :: Member TeamFeatureStore r => GetFeatureInternalParam -> - Sem r (Public.TeamFeatureStatus 'Public.TeamFeatureSelfDeletingMessages) + Sem r (Public.TeamFeatureStatus 'Public.WithPaymentStatus 'Public.TeamFeatureSelfDeletingMessages) getSelfDeletingMessagesInternal = \case Left _ -> pure Public.defaultSelfDeletingMessagesStatus - Right tid -> - TeamFeatures.getSelfDeletingMessagesStatus tid - <&> maybe Public.defaultSelfDeletingMessagesStatus id + Right tid -> do + (maybeFeatureStatus, maybePaymentStatus) <- TeamFeatures.getSelfDeletingMessagesStatus tid + pure $ case (maybePaymentStatus, maybeFeatureStatus) of + (Just Public.PaymentUnlocked, Just featureStatus) -> + Public.TeamFeatureStatusWithConfigAndPaymentStatus + (Public.tfwcStatus featureStatus) + (Public.tfwcConfig featureStatus) + Public.PaymentUnlocked + (Just Public.PaymentUnlocked, Nothing) -> + Public.defaultSelfDeletingMessagesStatus {Public.tfwcapsPaymentStatus = Public.PaymentUnlocked} + (Just Public.PaymentLocked, _) -> Public.defaultSelfDeletingMessagesStatus + (Nothing, _) -> Public.defaultSelfDeletingMessagesStatus setSelfDeletingMessagesInternal :: - Members '[GundeckAccess, TeamFeatureStore, TeamStore, P.TinyLog] r => + Members + '[ GundeckAccess, + TeamStore, + TeamFeatureStore, + P.TinyLog, + Error TeamFeatureError + ] + r => TeamId -> - Public.TeamFeatureStatus 'Public.TeamFeatureSelfDeletingMessages -> - Sem r (Public.TeamFeatureStatus 'Public.TeamFeatureSelfDeletingMessages) + Public.TeamFeatureStatus 'Public.WithoutPaymentStatus 'Public.TeamFeatureSelfDeletingMessages -> + Sem r (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus 'Public.TeamFeatureSelfDeletingMessages) setSelfDeletingMessagesInternal tid st = do + guardPaymentStatus @'Public.TeamFeatureSelfDeletingMessages tid Public.PaymentLocked let pushEvent = pushFeatureConfigEvent tid $ Event.Event Event.Update Public.TeamFeatureSelfDeletingMessages (EdFeatureSelfDeletingMessagesChanged st) - (TeamFeatures.setSelfDeletingMessagesStatus tid st) <* pushEvent + TeamFeatures.setSelfDeletingMessagesStatus tid st <* pushEvent + +-- TODO(fisx): move this function to a more suitable place / module. +guardPaymentStatus :: + forall (a :: Public.TeamFeatureName) r. + ( MaybeHasPaymentStatusCol a, + Member TeamFeatureStore r, + Member (Error TeamFeatureError) r + ) => + TeamId -> + Public.PaymentStatusValue -> -- FUTUREWORK(fisx): move this into its own type class and infer from `a`? + Sem r () +guardPaymentStatus tid defPaymentStatus = do + (TeamFeatures.getPaymentStatus @a tid <&> fromMaybe defPaymentStatus) >>= \case + Public.PaymentUnlocked -> pure () + Public.PaymentLocked -> throw PaymentStatusLocked pushFeatureConfigEvent :: Members '[GundeckAccess, TeamStore, P.TinyLog] r => @@ -588,7 +646,7 @@ pushFeatureConfigEvent tid event = do let recipients = membersToRecipients Nothing (memList ^. teamMembers) for_ (newPush (memList ^. teamMemberListType) Nothing (FeatureConfigEvent event) recipients) - (push1) + push1 -- | (Currently, we only have 'Public.TeamFeatureConferenceCalling' here, but we may have to -- extend this in the future.) @@ -597,5 +655,5 @@ getFeatureConfigViaAccount :: Member BrigAccess r ) => UserId -> - Sem r (Public.TeamFeatureStatus flag) + Sem r (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus flag) getFeatureConfigViaAccount = getAccountFeatureConfigClient diff --git a/services/galley/src/Galley/Cassandra.hs b/services/galley/src/Galley/Cassandra.hs index a32e4fdce1..83a0a5abd1 100644 --- a/services/galley/src/Galley/Cassandra.hs +++ b/services/galley/src/Galley/Cassandra.hs @@ -20,4 +20,4 @@ module Galley.Cassandra (schemaVersion) where import Imports schemaVersion :: Int32 -schemaVersion = 54 +schemaVersion = 55 diff --git a/services/galley/src/Galley/Cassandra/TeamFeatures.hs b/services/galley/src/Galley/Cassandra/TeamFeatures.hs index e723fe4768..bcd4cdc20d 100644 --- a/services/galley/src/Galley/Cassandra/TeamFeatures.hs +++ b/services/galley/src/Galley/Cassandra/TeamFeatures.hs @@ -32,16 +32,17 @@ import Wire.API.Team.Feature getFeatureStatusNoConfig :: forall (a :: TeamFeatureName) m. ( MonadClient m, - FeatureHasNoConfig a, + FeatureHasNoConfig 'WithoutPaymentStatus a, + MaybeHasPaymentStatusCol a, HasStatusCol a ) => Proxy a -> TeamId -> - m (Maybe (TeamFeatureStatus a)) + m (Maybe (TeamFeatureStatus 'WithoutPaymentStatus a), Maybe PaymentStatusValue) getFeatureStatusNoConfig _ tid = do let q = query1 select (params LocalQuorum (Identity tid)) mStatusValue <- (>>= runIdentity) <$> retry x1 q - pure $ TeamFeatureStatusNoConfig <$> mStatusValue + pure (TeamFeatureStatusNoConfig <$> mStatusValue, error "todo") where select :: PrepQuery R (Identity TeamId) (Identity (Maybe TeamFeatureStatusValue)) select = fromString $ "select " <> statusCol @a <> " from team_features where team_id = ?" @@ -49,13 +50,13 @@ getFeatureStatusNoConfig _ tid = do setFeatureStatusNoConfig :: forall (a :: TeamFeatureName) m. ( MonadClient m, - FeatureHasNoConfig a, + FeatureHasNoConfig 'WithoutPaymentStatus a, HasStatusCol a ) => Proxy a -> TeamId -> - TeamFeatureStatus a -> - m (TeamFeatureStatus a) + TeamFeatureStatus 'WithoutPaymentStatus a -> + m (TeamFeatureStatus 'WithoutPaymentStatus a) setFeatureStatusNoConfig _ tid status = do let flag = tfwoStatus status retry x5 $ write insert (params LocalQuorum (tid, flag)) @@ -68,7 +69,7 @@ getApplockFeatureStatus :: forall m. (MonadClient m) => TeamId -> - m (Maybe (TeamFeatureStatus 'TeamFeatureAppLock)) + m (Maybe (TeamFeatureStatus 'WithoutPaymentStatus 'TeamFeatureAppLock)) getApplockFeatureStatus tid = do let q = query1 select (params LocalQuorum (Identity tid)) mTuple <- retry x1 q @@ -85,8 +86,8 @@ getApplockFeatureStatus tid = do setApplockFeatureStatus :: (MonadClient m) => TeamId -> - TeamFeatureStatus 'TeamFeatureAppLock -> - m (TeamFeatureStatus 'TeamFeatureAppLock) + TeamFeatureStatus 'WithoutPaymentStatus 'TeamFeatureAppLock -> + m (TeamFeatureStatus 'WithoutPaymentStatus 'TeamFeatureAppLock) setApplockFeatureStatus tid status = do let statusValue = tfwcStatus status enforce = applockEnforceAppLock . tfwcConfig $ status @@ -105,27 +106,30 @@ getSelfDeletingMessagesStatus :: forall m. (MonadClient m) => TeamId -> - m (Maybe (TeamFeatureStatus 'TeamFeatureSelfDeletingMessages)) + m (Maybe (TeamFeatureStatus 'WithoutPaymentStatus 'TeamFeatureSelfDeletingMessages), Maybe PaymentStatusValue) getSelfDeletingMessagesStatus tid = do let q = query1 select (params LocalQuorum (Identity tid)) mTuple <- retry x1 q - pure $ - mTuple >>= \(mbStatusValue, mbTimeout) -> - TeamFeatureStatusWithConfig <$> mbStatusValue <*> (TeamFeatureSelfDeletingMessagesConfig <$> mbTimeout) + pure + ( mTuple >>= \(mbStatusValue, mbTimeout, _) -> + TeamFeatureStatusWithConfig <$> mbStatusValue <*> (TeamFeatureSelfDeletingMessagesConfig <$> mbTimeout), + mTuple >>= \(_, _, mbPaymentStatus) -> mbPaymentStatus + ) where - select :: PrepQuery R (Identity TeamId) (Maybe TeamFeatureStatusValue, Maybe Int32) + select :: PrepQuery R (Identity TeamId) (Maybe TeamFeatureStatusValue, Maybe Int32, Maybe PaymentStatusValue) select = fromString $ "select " <> statusCol @'TeamFeatureSelfDeletingMessages - <> ", self_deleting_messages_ttl " - <> "from team_features where team_id = ?" + <> ", self_deleting_messages_ttl, " + <> paymentStatusCol @'TeamFeatureSelfDeletingMessages + <> " from team_features where team_id = ?" setSelfDeletingMessagesStatus :: (MonadClient m) => TeamId -> - TeamFeatureStatus 'TeamFeatureSelfDeletingMessages -> - m (TeamFeatureStatus 'TeamFeatureSelfDeletingMessages) + TeamFeatureStatus 'WithoutPaymentStatus 'TeamFeatureSelfDeletingMessages -> + m (TeamFeatureStatus 'WithoutPaymentStatus 'TeamFeatureSelfDeletingMessages) setSelfDeletingMessagesStatus tid status = do let statusValue = tfwcStatus status timeout = sdmEnforcedTimeoutSeconds . tfwcConfig $ status @@ -140,6 +144,46 @@ setSelfDeletingMessagesStatus tid status = do <> ", self_deleting_messages_ttl) " <> "values (?, ?, ?)" +setPaymentStatus :: + forall (a :: TeamFeatureName) m. + ( MonadClient m, + HasPaymentStatusCol a + ) => + Proxy a -> + TeamId -> + PaymentStatus -> + m PaymentStatus +setPaymentStatus _ tid (PaymentStatus paymentStatus) = do + retry x5 $ write insert (params LocalQuorum (tid, paymentStatus)) + pure (PaymentStatus paymentStatus) + where + insert :: PrepQuery W (TeamId, PaymentStatusValue) () + insert = + fromString $ + "insert into team_features (team_id, " <> paymentStatusCol @a <> ") values (?, ?)" + +getPaymentStatus :: + forall (a :: TeamFeatureName) m. + ( MonadClient m, + MaybeHasPaymentStatusCol a + ) => + Proxy a -> + TeamId -> + m (Maybe PaymentStatusValue) +getPaymentStatus _ tid = + case maybePaymentStatusCol @a of + Nothing -> pure Nothing + Just paymentStatusColName -> do + let q = query1 select (params LocalQuorum (Identity tid)) + (>>= runIdentity) <$> retry x1 q + where + select :: PrepQuery R (Identity TeamId) (Identity (Maybe PaymentStatusValue)) + select = + fromString $ + "select " + <> paymentStatusColName + <> " from team_features where team_id = ?" + interpretTeamFeatureStoreToCassandra :: Members '[Embed IO, Input ClientState] r => Sem (TeamFeatureStore ': r) a -> @@ -147,6 +191,8 @@ interpretTeamFeatureStoreToCassandra :: interpretTeamFeatureStoreToCassandra = interpret $ \case GetFeatureStatusNoConfig' p tid -> embedClient $ getFeatureStatusNoConfig p tid SetFeatureStatusNoConfig' p tid value -> embedClient $ setFeatureStatusNoConfig p tid value + SetPaymentStatus' p tid value -> embedClient $ setPaymentStatus p tid value + GetPaymentStatus' p tid -> embedClient $ getPaymentStatus p tid GetApplockFeatureStatus tid -> embedClient $ getApplockFeatureStatus tid SetApplockFeatureStatus tid value -> embedClient $ setApplockFeatureStatus tid value GetSelfDeletingMessagesStatus tid -> embedClient $ getSelfDeletingMessagesStatus tid diff --git a/services/galley/src/Galley/Data/TeamFeatures.hs b/services/galley/src/Galley/Data/TeamFeatures.hs index e7ab337d0f..3e086a6333 100644 --- a/services/galley/src/Galley/Data/TeamFeatures.hs +++ b/services/galley/src/Galley/Data/TeamFeatures.hs @@ -15,7 +15,7 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Galley.Data.TeamFeatures (HasStatusCol (..)) where +module Galley.Data.TeamFeatures (HasStatusCol (..), HasPaymentStatusCol (..), MaybeHasPaymentStatusCol (..)) where import Imports import Wire.API.Team.Feature @@ -48,3 +48,34 @@ instance HasStatusCol 'TeamFeatureFileSharing where statusCol = "file_sharing" instance HasStatusCol 'TeamFeatureConferenceCalling where statusCol = "conference_calling" instance HasStatusCol 'TeamFeatureSelfDeletingMessages where statusCol = "self_deleting_messages_status" + +---------------------------------------------------------------------- +class HasPaymentStatusCol (a :: TeamFeatureName) where + paymentStatusCol :: String + +class MaybeHasPaymentStatusCol (a :: TeamFeatureName) where + maybePaymentStatusCol :: Maybe String + +instance {-# OVERLAPPABLE #-} HasPaymentStatusCol a => MaybeHasPaymentStatusCol a where + maybePaymentStatusCol = Just (paymentStatusCol @a) + +---------------------------------------------------------------------- +instance HasPaymentStatusCol 'TeamFeatureSelfDeletingMessages where + paymentStatusCol = "self_deleting_messages_payment_status" + +instance HasPaymentStatusCol 'TeamFeatureConferenceCalling where + paymentStatusCol = "conference_calling_payment_status" + +instance MaybeHasPaymentStatusCol 'TeamFeatureLegalHold where maybePaymentStatusCol = Nothing + +instance MaybeHasPaymentStatusCol 'TeamFeatureSSO where maybePaymentStatusCol = Nothing + +instance MaybeHasPaymentStatusCol 'TeamFeatureSearchVisibility where maybePaymentStatusCol = Nothing + +instance MaybeHasPaymentStatusCol 'TeamFeatureValidateSAMLEmails where maybePaymentStatusCol = Nothing + +instance MaybeHasPaymentStatusCol 'TeamFeatureDigitalSignatures where maybePaymentStatusCol = Nothing + +instance MaybeHasPaymentStatusCol 'TeamFeatureAppLock where maybePaymentStatusCol = Nothing + +instance MaybeHasPaymentStatusCol 'TeamFeatureFileSharing where maybePaymentStatusCol = Nothing diff --git a/services/galley/src/Galley/Effects/TeamFeatureStore.hs b/services/galley/src/Galley/Effects/TeamFeatureStore.hs index d2910980f2..92702ea1e7 100644 --- a/services/galley/src/Galley/Effects/TeamFeatureStore.hs +++ b/services/galley/src/Galley/Effects/TeamFeatureStore.hs @@ -23,6 +23,8 @@ module Galley.Effects.TeamFeatureStore setApplockFeatureStatus, getSelfDeletingMessagesStatus, setSelfDeletingMessagesStatus, + setPaymentStatus, + getPaymentStatus, ) where @@ -37,50 +39,81 @@ data TeamFeatureStore m a where -- the proxy argument makes sure that makeSem below generates type-inference-friendly code GetFeatureStatusNoConfig' :: forall (a :: TeamFeatureName) m. - ( FeatureHasNoConfig a, + ( FeatureHasNoConfig 'WithoutPaymentStatus a, + MaybeHasPaymentStatusCol a, HasStatusCol a ) => Proxy a -> TeamId -> - TeamFeatureStore m (Maybe (TeamFeatureStatus a)) + TeamFeatureStore m (Maybe (TeamFeatureStatus 'WithoutPaymentStatus a), Maybe PaymentStatusValue) -- the proxy argument makes sure that makeSem below generates type-inference-friendly code SetFeatureStatusNoConfig' :: forall (a :: TeamFeatureName) m. - ( FeatureHasNoConfig a, + ( FeatureHasNoConfig 'WithoutPaymentStatus a, HasStatusCol a ) => Proxy a -> TeamId -> - TeamFeatureStatus a -> - TeamFeatureStore m (TeamFeatureStatus a) + TeamFeatureStatus 'WithoutPaymentStatus a -> + TeamFeatureStore m (TeamFeatureStatus 'WithoutPaymentStatus a) GetApplockFeatureStatus :: TeamId -> - TeamFeatureStore m (Maybe (TeamFeatureStatus 'TeamFeatureAppLock)) + TeamFeatureStore m (Maybe (TeamFeatureStatus ps 'TeamFeatureAppLock)) SetApplockFeatureStatus :: TeamId -> - TeamFeatureStatus 'TeamFeatureAppLock -> - TeamFeatureStore m (TeamFeatureStatus 'TeamFeatureAppLock) + TeamFeatureStatus 'WithoutPaymentStatus 'TeamFeatureAppLock -> + TeamFeatureStore m (TeamFeatureStatus 'WithoutPaymentStatus 'TeamFeatureAppLock) GetSelfDeletingMessagesStatus :: TeamId -> - TeamFeatureStore m (Maybe (TeamFeatureStatus 'TeamFeatureSelfDeletingMessages)) + TeamFeatureStore m (Maybe (TeamFeatureStatus 'WithoutPaymentStatus 'TeamFeatureSelfDeletingMessages), Maybe PaymentStatusValue) SetSelfDeletingMessagesStatus :: TeamId -> - TeamFeatureStatus 'TeamFeatureSelfDeletingMessages -> - TeamFeatureStore m (TeamFeatureStatus 'TeamFeatureSelfDeletingMessages) + TeamFeatureStatus 'WithoutPaymentStatus 'TeamFeatureSelfDeletingMessages -> + TeamFeatureStore m (TeamFeatureStatus 'WithoutPaymentStatus 'TeamFeatureSelfDeletingMessages) + SetPaymentStatus' :: + forall (a :: TeamFeatureName) m. + ( HasPaymentStatusCol a + ) => + Proxy a -> + TeamId -> + PaymentStatus -> + TeamFeatureStore m PaymentStatus + GetPaymentStatus' :: + forall (a :: TeamFeatureName) m. + ( MaybeHasPaymentStatusCol a + ) => + Proxy a -> + TeamId -> + TeamFeatureStore m (Maybe PaymentStatusValue) makeSem ''TeamFeatureStore getFeatureStatusNoConfig :: forall (a :: TeamFeatureName) r. - (Member TeamFeatureStore r, FeatureHasNoConfig a, HasStatusCol a) => + (Member TeamFeatureStore r, FeatureHasNoConfig 'WithoutPaymentStatus a, HasStatusCol a, MaybeHasPaymentStatusCol a) => TeamId -> - Sem r (Maybe (TeamFeatureStatus a)) + Sem r (Maybe (TeamFeatureStatus 'WithoutPaymentStatus a), Maybe PaymentStatusValue) getFeatureStatusNoConfig = getFeatureStatusNoConfig' (Proxy @a) setFeatureStatusNoConfig :: forall (a :: TeamFeatureName) r. - (Member TeamFeatureStore r, FeatureHasNoConfig a, HasStatusCol a) => + (Member TeamFeatureStore r, FeatureHasNoConfig 'WithoutPaymentStatus a, HasStatusCol a) => TeamId -> - TeamFeatureStatus a -> - Sem r (TeamFeatureStatus a) + TeamFeatureStatus 'WithoutPaymentStatus a -> + Sem r (TeamFeatureStatus 'WithoutPaymentStatus a) setFeatureStatusNoConfig = setFeatureStatusNoConfig' (Proxy @a) + +setPaymentStatus :: + forall (a :: TeamFeatureName) r. + (Member TeamFeatureStore r, HasPaymentStatusCol a) => + TeamId -> + PaymentStatus -> + Sem r PaymentStatus +setPaymentStatus = setPaymentStatus' (Proxy @a) + +getPaymentStatus :: + forall (a :: TeamFeatureName) r. + (Member TeamFeatureStore r, MaybeHasPaymentStatusCol a) => + TeamId -> + Sem r (Maybe PaymentStatusValue) +getPaymentStatus = getPaymentStatus' (Proxy @a) diff --git a/services/galley/src/Galley/Intra/User.hs b/services/galley/src/Galley/Intra/User.hs index 70a0483ebc..907e2fb17f 100644 --- a/services/galley/src/Galley/Intra/User.hs +++ b/services/galley/src/Galley/Intra/User.hs @@ -233,7 +233,8 @@ getAccountFeatureConfigClient uid = handleResp (Left errmsg) = throwM . internalErrorWithDescription . cs . show $ errmsg getAccountFeatureConfigClientM :: - UserId -> Client.ClientM TeamFeatureStatusNoConfig + UserId -> + Client.ClientM TeamFeatureStatusNoConfig ( _ :<|> getAccountFeatureConfigClientM :<|> _ diff --git a/services/galley/test/integration/API/Teams.hs b/services/galley/test/integration/API/Teams.hs index 43985abb00..f539707b41 100644 --- a/services/galley/test/integration/API/Teams.hs +++ b/services/galley/test/integration/API/Teams.hs @@ -355,7 +355,7 @@ testEnableSSOPerTeam = do assertQueue "create team" tActivate let check :: HasCallStack => String -> Public.TeamFeatureStatusValue -> TestM () check msg enabledness = do - status :: Public.TeamFeatureStatus 'Public.TeamFeatureSSO <- responseJsonUnsafe <$> (getSSOEnabledInternal tid (getSSOEnabledInternal tid TestM () @@ -382,10 +382,10 @@ testEnableSSOPerTeam = do testEnableTeamSearchVisibilityPerTeam :: TestM () testEnableTeamSearchVisibilityPerTeam = do g <- view tsGalley - (tid, owner, (member : _)) <- Util.createBindingTeamWithMembers 2 + (tid, owner, member : _) <- Util.createBindingTeamWithMembers 2 let check :: (HasCallStack, MonadCatch m, MonadIO m, Monad m, MonadHttp m) => String -> Public.TeamFeatureStatusValue -> m () check msg enabledness = do - status :: Public.TeamFeatureStatus 'Public.TeamFeatureSearchVisibility <- responseJsonUnsafe <$> (Util.getTeamSearchVisibilityAvailableInternal g tid (Util.getTeamSearchVisibilityAvailableInternal g tid return (x, xs) (201, 200, _, _) -> createAndConnectUserWhileLimitNotReached alice (remaining -1) ((uid, cid) : acc) pk (403, 403, _, []) -> error "Need to connect with at least 1 user" - (403, 403, _, (x : xs)) -> return (x, xs) + (403, 403, _, x : xs) -> return (x, xs) (xxx, yyy, _, _) -> error ("Unexpected while connecting users: " ++ show xxx ++ " and " ++ show yyy) newTeamMember' :: Permissions -> UserId -> TeamMember @@ -1892,7 +1892,7 @@ getSSOEnabledInternal :: HasCallStack => TeamId -> TestM ResponseLBS getSSOEnabledInternal = Util.getTeamFeatureFlagInternal Public.TeamFeatureSSO putSSOEnabledInternal :: HasCallStack => TeamId -> Public.TeamFeatureStatusValue -> TestM () -putSSOEnabledInternal tid statusValue = Util.putTeamFeatureFlagInternal @'Public.TeamFeatureSSO expect2xx tid (Public.TeamFeatureStatusNoConfig statusValue) +putSSOEnabledInternal tid statusValue = void $ Util.putTeamFeatureFlagInternal @'Public.WithoutPaymentStatus @'Public.TeamFeatureSSO expect2xx tid (Public.TeamFeatureStatusNoConfig statusValue) getSearchVisibility :: HasCallStack => (Request -> Request) -> UserId -> TeamId -> (MonadIO m, MonadHttp m) => m ResponseLBS getSearchVisibility g uid tid = do diff --git a/services/galley/test/integration/API/Teams/Feature.hs b/services/galley/test/integration/API/Teams/Feature.hs index 76c5f7b408..9af553bbca 100644 --- a/services/galley/test/integration/API/Teams/Feature.hs +++ b/services/galley/test/integration/API/Teams/Feature.hs @@ -60,15 +60,15 @@ tests s = [ test s "SSO" testSSO, test s "LegalHold" testLegalHold, test s "SearchVisibility" testSearchVisibility, - test s "DigitalSignatures" $ testSimpleFlag @'Public.TeamFeatureDigitalSignatures Public.TeamFeatureDisabled, - test s "ValidateSAMLEmails" $ testSimpleFlag @'Public.TeamFeatureValidateSAMLEmails Public.TeamFeatureDisabled, - test s "FileSharing" $ testSimpleFlag @'Public.TeamFeatureFileSharing Public.TeamFeatureEnabled, + test s "DigitalSignatures" $ testSimpleFlag @'Public.WithoutPaymentStatus @'Public.TeamFeatureDigitalSignatures Public.TeamFeatureDisabled, + test s "ValidateSAMLEmails" $ testSimpleFlag @'Public.WithoutPaymentStatus @'Public.TeamFeatureValidateSAMLEmails Public.TeamFeatureDisabled, + test s "FileSharing" $ testSimpleFlag @'Public.WithoutPaymentStatus @'Public.TeamFeatureFileSharing Public.TeamFeatureEnabled, test s "Classified Domains (enabled)" testClassifiedDomainsEnabled, test s "Classified Domains (disabled)" testClassifiedDomainsDisabled, test s "All features" testAllFeatures, test s "Feature Configs / Team Features Consistency" testFeatureConfigConsistency, - test s "ConferenceCalling" $ testSimpleFlag @'Public.TeamFeatureConferenceCalling Public.TeamFeatureEnabled, - test s "SelfDeletingMessages" $ testSelfDeletingMessages + test s "ConferenceCalling" $ testSimpleFlag @'Public.WithoutPaymentStatus @'Public.TeamFeatureConferenceCalling Public.TeamFeatureEnabled, + test s "SelfDeletingMessages" testSelfDeletingMessages ] testSSO :: TestM () @@ -81,13 +81,13 @@ testSSO = do Util.addTeamMember owner tid member (rolePermissions RoleMember) Nothing let getSSO :: HasCallStack => Public.TeamFeatureStatusValue -> TestM () - getSSO = assertFlagNoConfig @'Public.TeamFeatureSSO $ Util.getTeamFeatureFlag Public.TeamFeatureSSO member tid + getSSO = assertFlagNoConfig @'Public.WithoutPaymentStatus @'Public.TeamFeatureSSO $ Util.getTeamFeatureFlag Public.TeamFeatureSSO member tid getSSOFeatureConfig :: HasCallStack => Public.TeamFeatureStatusValue -> TestM () - getSSOFeatureConfig = assertFlagNoConfig @'Public.TeamFeatureSSO $ Util.getFeatureConfig Public.TeamFeatureSSO member + getSSOFeatureConfig = assertFlagNoConfig @'Public.WithoutPaymentStatus @'Public.TeamFeatureSSO $ Util.getFeatureConfig Public.TeamFeatureSSO member getSSOInternal :: HasCallStack => Public.TeamFeatureStatusValue -> TestM () - getSSOInternal = assertFlagNoConfig @'Public.TeamFeatureSSO $ Util.getTeamFeatureFlagInternal Public.TeamFeatureSSO tid + getSSOInternal = assertFlagNoConfig @'Public.WithoutPaymentStatus @'Public.TeamFeatureSSO $ Util.getTeamFeatureFlagInternal Public.TeamFeatureSSO tid setSSOInternal :: HasCallStack => Public.TeamFeatureStatusValue -> TestM () - setSSOInternal = Util.putTeamFeatureFlagInternal @'Public.TeamFeatureSSO expect2xx tid . Public.TeamFeatureStatusNoConfig + setSSOInternal = void . Util.putTeamFeatureFlagInternal @'Public.WithoutPaymentStatus @'Public.TeamFeatureSSO expect2xx tid . Public.TeamFeatureStatusNoConfig assertFlagForbidden $ Util.getTeamFeatureFlag Public.TeamFeatureSSO nonMember tid @@ -121,13 +121,13 @@ testLegalHold = do Util.addTeamMember owner tid member (rolePermissions RoleMember) Nothing let getLegalHold :: HasCallStack => Public.TeamFeatureStatusValue -> TestM () - getLegalHold = assertFlagNoConfig @'Public.TeamFeatureLegalHold $ Util.getTeamFeatureFlag Public.TeamFeatureLegalHold member tid + getLegalHold = assertFlagNoConfig @'Public.WithoutPaymentStatus @'Public.TeamFeatureLegalHold $ Util.getTeamFeatureFlag Public.TeamFeatureLegalHold member tid getLegalHoldInternal :: HasCallStack => Public.TeamFeatureStatusValue -> TestM () - getLegalHoldInternal = assertFlagNoConfig @'Public.TeamFeatureLegalHold $ Util.getTeamFeatureFlagInternal Public.TeamFeatureLegalHold tid - getLegalHoldFeatureConfig = assertFlagNoConfig @'Public.TeamFeatureLegalHold $ Util.getFeatureConfig Public.TeamFeatureLegalHold member + getLegalHoldInternal = assertFlagNoConfig @'Public.WithoutPaymentStatus @'Public.TeamFeatureLegalHold $ Util.getTeamFeatureFlagInternal Public.TeamFeatureLegalHold tid + getLegalHoldFeatureConfig = assertFlagNoConfig @'Public.WithoutPaymentStatus @'Public.TeamFeatureLegalHold $ Util.getFeatureConfig Public.TeamFeatureLegalHold member setLegalHoldInternal :: HasCallStack => Public.TeamFeatureStatusValue -> TestM () - setLegalHoldInternal = Util.putTeamFeatureFlagInternal @'Public.TeamFeatureLegalHold expect2xx tid . Public.TeamFeatureStatusNoConfig + setLegalHoldInternal = void . Util.putTeamFeatureFlagInternal @'Public.WithoutPaymentStatus @'Public.TeamFeatureLegalHold expect2xx tid . Public.TeamFeatureStatusNoConfig getLegalHold Public.TeamFeatureDisabled getLegalHoldInternal Public.TeamFeatureDisabled @@ -249,7 +249,7 @@ getClassifiedDomains :: (HasCallStack, HasGalley m, MonadIO m, MonadHttp m, MonadCatch m) => UserId -> TeamId -> - Public.TeamFeatureStatus 'Public.TeamFeatureClassifiedDomains -> + Public.TeamFeatureStatus 'Public.WithoutPaymentStatus 'Public.TeamFeatureClassifiedDomains -> m () getClassifiedDomains member tid = assertFlagWithConfig @Public.TeamFeatureClassifiedDomainsConfig $ @@ -258,7 +258,7 @@ getClassifiedDomains member tid = getClassifiedDomainsInternal :: (HasCallStack, HasGalley m, MonadIO m, MonadHttp m, MonadCatch m) => TeamId -> - Public.TeamFeatureStatus 'Public.TeamFeatureClassifiedDomains -> + Public.TeamFeatureStatus 'Public.WithoutPaymentStatus 'Public.TeamFeatureClassifiedDomains -> m () getClassifiedDomainsInternal tid = assertFlagWithConfig @Public.TeamFeatureClassifiedDomainsConfig $ @@ -276,7 +276,7 @@ testClassifiedDomainsEnabled = do let getClassifiedDomainsFeatureConfig :: (HasCallStack, HasGalley m, MonadIO m, MonadHttp m, MonadCatch m) => UserId -> - Public.TeamFeatureStatus 'Public.TeamFeatureClassifiedDomains -> + Public.TeamFeatureStatus 'Public.WithoutPaymentStatus 'Public.TeamFeatureClassifiedDomains -> m () getClassifiedDomainsFeatureConfig uid = do assertFlagWithConfig @Public.TeamFeatureClassifiedDomainsConfig $ @@ -298,7 +298,7 @@ testClassifiedDomainsDisabled = do let getClassifiedDomainsFeatureConfig :: (HasCallStack, HasGalley m, MonadIO m, MonadHttp m, MonadCatch m) => UserId -> - Public.TeamFeatureStatus 'Public.TeamFeatureClassifiedDomains -> + Public.TeamFeatureStatus 'Public.WithoutPaymentStatus 'Public.TeamFeatureClassifiedDomains -> m () getClassifiedDomainsFeatureConfig uid = do assertFlagWithConfig @Public.TeamFeatureClassifiedDomainsConfig $ @@ -316,13 +316,13 @@ testClassifiedDomainsDisabled = do getClassifiedDomainsFeatureConfig member expected testSimpleFlag :: - forall (a :: Public.TeamFeatureName). + forall (ps :: Public.IncludePaymentStatus) (a :: Public.TeamFeatureName). ( HasCallStack, Typeable a, - Public.FeatureHasNoConfig a, + Public.FeatureHasNoConfig ps a, Public.KnownTeamFeatureName a, - FromJSON (Public.TeamFeatureStatus a), - ToJSON (Public.TeamFeatureStatus a) + FromJSON (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus a), + ToJSON (Public.TeamFeatureStatus ps a) ) => Public.TeamFeatureStatusValue -> TestM () @@ -337,19 +337,19 @@ testSimpleFlag defaultValue = do let getFlag :: HasCallStack => Public.TeamFeatureStatusValue -> TestM () getFlag expected = - flip (assertFlagNoConfig @a) expected $ Util.getTeamFeatureFlag feature member tid + flip (assertFlagNoConfig @ps @a) expected $ Util.getTeamFeatureFlag feature member tid getFeatureConfig :: HasCallStack => Public.TeamFeatureStatusValue -> TestM () getFeatureConfig expected = - flip (assertFlagNoConfig @a) expected $ Util.getFeatureConfig feature member + flip (assertFlagNoConfig @ps @a) expected $ Util.getFeatureConfig feature member getFlagInternal :: HasCallStack => Public.TeamFeatureStatusValue -> TestM () getFlagInternal expected = - flip (assertFlagNoConfig @a) expected $ Util.getTeamFeatureFlagInternal feature tid + flip (assertFlagNoConfig @ps @a) expected $ Util.getTeamFeatureFlagInternal feature tid setFlagInternal :: Public.TeamFeatureStatusValue -> TestM () setFlagInternal statusValue = - Util.putTeamFeatureFlagInternal @a expect2xx tid (Public.TeamFeatureStatusNoConfig statusValue) + void $ Util.putTeamFeatureFlagInternal @ps @a expect2xx tid (Public.TeamFeatureStatusNoConfig statusValue) assertFlagForbidden $ Util.getTeamFeatureFlag feature nonMember tid @@ -381,31 +381,39 @@ testSimpleFlag defaultValue = do testSelfDeletingMessages :: TestM () testSelfDeletingMessages = do -- personal users - let setting :: TeamFeatureStatusValue -> Int32 -> Public.TeamFeatureStatus 'Public.TeamFeatureSelfDeletingMessages - setting stat tout = + let settingWithoutPaymentStatus :: TeamFeatureStatusValue -> Int32 -> Public.TeamFeatureStatus 'Public.WithoutPaymentStatus 'Public.TeamFeatureSelfDeletingMessages + settingWithoutPaymentStatus stat tout = Public.TeamFeatureStatusWithConfig @Public.TeamFeatureSelfDeletingMessagesConfig stat (Public.TeamFeatureSelfDeletingMessagesConfig tout) + settingWithPaymentStatus :: TeamFeatureStatusValue -> Int32 -> Public.PaymentStatusValue -> Public.TeamFeatureStatus 'Public.WithPaymentStatus 'Public.TeamFeatureSelfDeletingMessages + settingWithPaymentStatus stat tout paymentStatus = + Public.TeamFeatureStatusWithConfigAndPaymentStatus @Public.TeamFeatureSelfDeletingMessagesConfig + stat + (Public.TeamFeatureSelfDeletingMessagesConfig tout) + paymentStatus personalUser <- Util.randomUser Util.getFeatureConfig Public.TeamFeatureSelfDeletingMessages personalUser - !!! responseJsonEither === const (Right $ setting TeamFeatureEnabled 0) + !!! responseJsonEither === const (Right $ settingWithPaymentStatus TeamFeatureEnabled 0 Public.PaymentLocked) -- team users galley <- view tsGalley (owner, tid, []) <- Util.createBindingTeamWithNMembers 0 - let checkSet :: TeamFeatureStatusValue -> Int32 -> TestM () - checkSet stat tout = do - Util.putTeamFeatureFlagInternal @'Public.TeamFeatureSelfDeletingMessages - galley - tid - (setting stat tout) + let checkSet :: TeamFeatureStatusValue -> Int32 -> Int -> TestM () + checkSet stat tout expectedStatusCode = + do + Util.putTeamFeatureFlagInternal @'Public.WithoutPaymentStatus @'Public.TeamFeatureSelfDeletingMessages + galley + tid + (settingWithoutPaymentStatus stat tout) + !!! statusCode === const expectedStatusCode -- internal, public (/team/:tid/features), and team-agnostic (/feature-configs). - checkGet :: HasCallStack => TeamFeatureStatusValue -> Int32 -> TestM () - checkGet stat tout = do - let expected = setting stat tout + checkGet :: HasCallStack => TeamFeatureStatusValue -> Int32 -> Public.PaymentStatusValue -> TestM () + checkGet stat tout paymentStatus = do + let expected = settingWithPaymentStatus stat tout paymentStatus forM_ [ Util.getTeamFeatureFlagInternal Public.TeamFeatureSelfDeletingMessages tid, Util.getTeamFeatureFlagWithGalley Public.TeamFeatureSelfDeletingMessages galley owner tid, @@ -413,11 +421,30 @@ testSelfDeletingMessages = do ] (!!! responseJsonEither === const (Right expected)) - checkGet TeamFeatureEnabled 0 - checkSet TeamFeatureDisabled 0 - checkGet TeamFeatureDisabled 0 - checkSet TeamFeatureEnabled 30 - checkGet TeamFeatureEnabled 30 + checkSetPaymentStatus :: HasCallStack => Public.PaymentStatusValue -> TestM () + checkSetPaymentStatus status = + do + Util.setPaymentStatusInternal @'Public.TeamFeatureSelfDeletingMessages galley tid status + !!! statusCode === const 200 + + checkGet TeamFeatureEnabled 0 Public.PaymentLocked + checkSet TeamFeatureDisabled 0 409 + checkGet TeamFeatureEnabled 0 Public.PaymentLocked + checkSet TeamFeatureEnabled 30 409 + checkGet TeamFeatureEnabled 0 Public.PaymentLocked + checkSetPaymentStatus Public.PaymentUnlocked + checkGet TeamFeatureEnabled 0 Public.PaymentUnlocked + checkSet TeamFeatureDisabled 0 200 + checkGet TeamFeatureDisabled 0 Public.PaymentUnlocked + checkSet TeamFeatureEnabled 30 200 + checkGet TeamFeatureEnabled 30 Public.PaymentUnlocked + checkSet TeamFeatureDisabled 30 200 + checkGet TeamFeatureDisabled 30 Public.PaymentUnlocked + checkSetPaymentStatus Public.PaymentLocked + checkGet TeamFeatureEnabled 0 Public.PaymentLocked + checkSet TeamFeatureEnabled 50 409 + checkSetPaymentStatus Public.PaymentUnlocked + checkGet TeamFeatureDisabled 30 Public.PaymentUnlocked -- | Call 'GET /teams/:tid/features' and 'GET /feature-configs', and check if all -- features are there. @@ -455,10 +482,10 @@ testAllFeatures = do toS TeamFeatureConferenceCalling .= Public.TeamFeatureStatusNoConfig confCalling, toS TeamFeatureSelfDeletingMessages - .= ( Public.TeamFeatureStatusWithConfig @Public.TeamFeatureSelfDeletingMessagesConfig - TeamFeatureEnabled - (Public.TeamFeatureSelfDeletingMessagesConfig 0) - ) + .= Public.TeamFeatureStatusWithConfigAndPaymentStatus @Public.TeamFeatureSelfDeletingMessagesConfig + TeamFeatureEnabled + (Public.TeamFeatureSelfDeletingMessagesConfig 0) + Public.PaymentLocked ] toS :: TeamFeatureName -> Text toS = TE.decodeUtf8 . toByteString' @@ -478,8 +505,6 @@ testFeatureConfigConsistency = do unless (allTeamFeaturesRes `Set.isSubsetOf` allFeaturesRes) $ liftIO $ expectationFailure (show allTeamFeaturesRes <> " is not a subset of " <> show allFeaturesRes) - - pure () where parseObjectKeys :: ResponseLBS -> TestM (Set.Set Text) parseObjectKeys res = do @@ -500,11 +525,11 @@ assertFlagForbidden res = do fmap label . responseJsonMaybe === const (Just "no-team-member") assertFlagNoConfig :: - forall (a :: Public.TeamFeatureName). + forall (ps :: Public.IncludePaymentStatus) (a :: Public.TeamFeatureName). ( HasCallStack, Typeable a, - Public.FeatureHasNoConfig a, - FromJSON (Public.TeamFeatureStatus a), + Public.FeatureHasNoConfig ps a, + FromJSON (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus a), Public.KnownTeamFeatureName a ) => TestM ResponseLBS -> @@ -514,7 +539,7 @@ assertFlagNoConfig res expected = do res !!! do statusCode === const 200 ( fmap Public.tfwoStatus - . responseJsonEither @(Public.TeamFeatureStatus a) + . responseJsonEither @(Public.TeamFeatureStatus ps a) ) === const (Right expected) diff --git a/services/galley/test/integration/API/Teams/LegalHold.hs b/services/galley/test/integration/API/Teams/LegalHold.hs index 7ccefd4ea6..052ab80952 100644 --- a/services/galley/test/integration/API/Teams/LegalHold.hs +++ b/services/galley/test/integration/API/Teams/LegalHold.hs @@ -566,14 +566,14 @@ testEnablePerTeam = withTeam $ \owner tid -> do addTeamMemberInternal tid member (rolePermissions RoleMember) Nothing ensureQueueEmpty do - status :: Public.TeamFeatureStatus 'Public.TeamFeatureLegalHold <- responseJsonUnsafe <$> (getEnabled tid (getEnabled tid (getEnabled tid (getEnabled tid do @@ -585,7 +585,7 @@ testEnablePerTeam = withTeam $ \owner tid -> do liftIO $ assertEqual "User legal hold status should be enabled" UserLegalHoldEnabled status do putEnabled' id tid Public.TeamFeatureDisabled !!! testResponse 403 (Just "legalhold-whitelisted-only") - status :: Public.TeamFeatureStatus 'Public.TeamFeatureLegalHold <- responseJsonUnsafe <$> (getEnabled tid (getEnabled tid (getEnabled tid (getEnabled tid (getEnabled tid (getEnabled tid do @@ -554,7 +554,7 @@ testEnablePerTeam = do liftIO $ assertEqual "User legal hold status should be enabled" UserLegalHoldEnabled status do putEnabled tid Public.TeamFeatureDisabled -- disable again - status :: Public.TeamFeatureStatus 'Public.TeamFeatureLegalHold <- responseJsonUnsafe <$> (getEnabled tid (getEnabled tid (getEnabled tid (getEnabled tid (getEnabled tid (getEnabled tid (MonadIO m, MonadHttp m) => m () putTeamSearchVisibilityAvailableInternal g tid statusValue = - putTeamFeatureFlagInternalWithGalleyAndMod - @'Public.TeamFeatureSearchVisibility - g - expect2xx - tid - (Public.TeamFeatureStatusNoConfig statusValue) + void $ + putTeamFeatureFlagInternalWithGalleyAndMod + @'Public.WithoutPaymentStatus + @'Public.TeamFeatureSearchVisibility + g + expect2xx + tid + (Public.TeamFeatureStatusNoConfig statusValue) putLegalHoldEnabledInternal' :: HasCallStack => @@ -65,7 +67,7 @@ putLegalHoldEnabledInternal' :: Public.TeamFeatureStatusValue -> TestM () putLegalHoldEnabledInternal' g tid statusValue = - putTeamFeatureFlagInternal @'Public.TeamFeatureLegalHold g tid (Public.TeamFeatureStatusNoConfig statusValue) + void $ putTeamFeatureFlagInternal @'Public.WithoutPaymentStatus @'Public.TeamFeatureLegalHold g tid (Public.TeamFeatureStatusNoConfig statusValue) -------------------------------------------------------------------------------- @@ -149,35 +151,52 @@ getAllFeatureConfigsWithGalley galley uid = do . zUser uid putTeamFeatureFlagInternal :: - forall (a :: Public.TeamFeatureName). + forall (ps :: Public.IncludePaymentStatus) (a :: Public.TeamFeatureName). ( HasCallStack, Public.KnownTeamFeatureName a, - ToJSON (Public.TeamFeatureStatus a) + ToJSON (Public.TeamFeatureStatus ps a) ) => (Request -> Request) -> TeamId -> - (Public.TeamFeatureStatus a) -> - TestM () + Public.TeamFeatureStatus ps a -> + TestM ResponseLBS putTeamFeatureFlagInternal reqmod tid status = do g <- view tsGalley - putTeamFeatureFlagInternalWithGalleyAndMod @a g reqmod tid status + putTeamFeatureFlagInternalWithGalleyAndMod @ps @a g reqmod tid status putTeamFeatureFlagInternalWithGalleyAndMod :: - forall (a :: Public.TeamFeatureName) m. + forall (ps :: Public.IncludePaymentStatus) (a :: Public.TeamFeatureName) m. ( MonadIO m, MonadHttp m, HasCallStack, Public.KnownTeamFeatureName a, - ToJSON (Public.TeamFeatureStatus a) + ToJSON (Public.TeamFeatureStatus ps a) ) => (Request -> Request) -> (Request -> Request) -> TeamId -> - (Public.TeamFeatureStatus a) -> - m () + Public.TeamFeatureStatus ps a -> + m ResponseLBS putTeamFeatureFlagInternalWithGalleyAndMod galley reqmod tid status = - void . put $ + put $ galley . paths ["i", "teams", toByteString' tid, "features", toByteString' (Public.knownTeamFeatureName @a)] . json status . reqmod + +setPaymentStatusInternal :: + forall (a :: Public.TeamFeatureName). + ( HasCallStack, + Public.KnownTeamFeatureName a, + ToJSON Public.PaymentStatusValue + ) => + (Request -> Request) -> + TeamId -> + Public.PaymentStatusValue -> + TestM ResponseLBS +setPaymentStatusInternal reqmod tid paymentStatus = do + galley <- view tsGalley + put $ + galley + . paths ["i", "teams", toByteString' tid, "features", toByteString' (Public.knownTeamFeatureName @a), toByteString' paymentStatus] + . reqmod diff --git a/services/spar/src/Spar/Intra/Galley.hs b/services/spar/src/Spar/Intra/Galley.hs index d8a0bc6291..53184e0e15 100644 --- a/services/spar/src/Spar/Intra/Galley.hs +++ b/services/spar/src/Spar/Intra/Galley.hs @@ -31,7 +31,13 @@ import Imports import Network.HTTP.Types.Method import Spar.Error import qualified System.Logger.Class as Log -import Wire.API.Team.Feature (TeamFeatureName (..), TeamFeatureStatus, TeamFeatureStatusNoConfig (..), TeamFeatureStatusValue (..)) +import Wire.API.Team.Feature + ( IncludePaymentStatus (..), + TeamFeatureName (..), + TeamFeatureStatus, + TeamFeatureStatusNoConfig (..), + TeamFeatureStatusValue (..), + ) ---------------------------------------------------------------------- @@ -88,7 +94,7 @@ isEmailValidationEnabledTeam tid = do resp <- call $ method GET . paths ["i", "teams", toByteString' tid, "features", "validateSAMLemails"] pure ( (statusCode resp == 200) - && ( responseJsonMaybe @(TeamFeatureStatus 'TeamFeatureValidateSAMLEmails) resp + && ( responseJsonMaybe @(TeamFeatureStatus 'WithoutPaymentStatus 'TeamFeatureValidateSAMLEmails) resp == Just (TeamFeatureStatusNoConfig TeamFeatureEnabled) ) ) diff --git a/tools/stern/src/Stern/API.hs b/tools/stern/src/Stern/API.hs index 27e8e72709..fe27d5e3fa 100644 --- a/tools/stern/src/Stern/API.hs +++ b/tools/stern/src/Stern/API.hs @@ -594,25 +594,25 @@ getTeamAdminInfo = liftM (json . toAdminInfo) . Intra.getTeamInfo getTeamFeatureFlagH :: forall (a :: Public.TeamFeatureName). ( Public.KnownTeamFeatureName a, - FromJSON (Public.TeamFeatureStatus a), - ToJSON (Public.TeamFeatureStatus a), - Typeable (Public.TeamFeatureStatus a) + FromJSON (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus a), + ToJSON (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus a), + Typeable (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus a) ) => TeamId -> Handler Response getTeamFeatureFlagH tid = - json <$> Intra.getTeamFeatureFlag @a tid + json <$> Intra.getTeamFeatureFlag @'Public.WithoutPaymentStatus @a tid setTeamFeatureFlagH :: forall (a :: Public.TeamFeatureName). ( Public.KnownTeamFeatureName a, - FromJSON (Public.TeamFeatureStatus a), - ToJSON (Public.TeamFeatureStatus a) + FromJSON (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus a), + ToJSON (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus a) ) => - TeamId ::: JsonRequest (Public.TeamFeatureStatus a) ::: JSON -> + TeamId ::: JsonRequest (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus a) ::: JSON -> Handler Response setTeamFeatureFlagH (tid ::: req ::: _) = do - status :: Public.TeamFeatureStatus a <- parseBody req !>> mkError status400 "client-error" + status :: Public.TeamFeatureStatus 'Public.WithoutPaymentStatus a <- parseBody req !>> mkError status400 "client-error" empty <$ Intra.setTeamFeatureFlag @a tid status getTeamFeatureFlagNoConfigH :: @@ -755,9 +755,9 @@ noSuchUser = ifNothing (mkError status404 "no-user" "No such user") mkFeaturePutGetRoute :: forall (a :: Public.TeamFeatureName). ( Public.KnownTeamFeatureName a, - FromJSON (Public.TeamFeatureStatus a), - ToJSON (Public.TeamFeatureStatus a), - Typeable (Public.TeamFeatureStatus a) + FromJSON (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus a), + ToJSON (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus a), + Typeable (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus a) ) => Routes Doc.ApiBuilder Handler () mkFeaturePutGetRoute = do @@ -774,7 +774,7 @@ mkFeaturePutGetRoute = do put ("/teams/:tid/features/" <> toByteString' featureName) (continue (setTeamFeatureFlagH @a)) $ capture "tid" - .&. jsonRequest @(Public.TeamFeatureStatus a) + .&. jsonRequest @(Public.TeamFeatureStatus 'Public.WithoutPaymentStatus a) .&. accept "application" "json" document "PUT" "setTeamFeatureFlag" $ do summary "Disable / enable feature flag for a given team" diff --git a/tools/stern/src/Stern/Intra.hs b/tools/stern/src/Stern/Intra.hs index e930aa76e0..4f8ffde988 100644 --- a/tools/stern/src/Stern/Intra.hs +++ b/tools/stern/src/Stern/Intra.hs @@ -452,13 +452,13 @@ setBlacklistStatus status emailOrPhone = do statusToMethod True = POST getTeamFeatureFlag :: - forall (a :: Public.TeamFeatureName). + forall (ps :: Public.IncludePaymentStatus) (a :: Public.TeamFeatureName). ( Public.KnownTeamFeatureName a, - Typeable (Public.TeamFeatureStatus a), - FromJSON (Public.TeamFeatureStatus a) + Typeable (Public.TeamFeatureStatus ps a), + FromJSON (Public.TeamFeatureStatus ps a) ) => TeamId -> - Handler (Public.TeamFeatureStatus a) + Handler (Public.TeamFeatureStatus ps a) getTeamFeatureFlag tid = do info $ msg "Getting team feature status" gly <- view galley @@ -467,17 +467,17 @@ getTeamFeatureFlag tid = do . paths ["/i/teams", toByteString' tid, "features", toByteString' (Public.knownTeamFeatureName @a)] resp <- catchRpcErrors $ rpc' "galley" gly req case Bilge.statusCode resp of - 200 -> pure $ responseJsonUnsafe @(Public.TeamFeatureStatus a) resp + 200 -> pure $ responseJsonUnsafe @(Public.TeamFeatureStatus ps a) resp 404 -> throwE (mkError status404 "bad-upstream" "team doesnt exist") _ -> throwE (mkError status502 "bad-upstream" "bad response") setTeamFeatureFlag :: forall (a :: Public.TeamFeatureName). ( Public.KnownTeamFeatureName a, - ToJSON (Public.TeamFeatureStatus a) + ToJSON (Public.TeamFeatureStatus 'Public.WithoutPaymentStatus a) ) => TeamId -> - Public.TeamFeatureStatus a -> + Public.TeamFeatureStatus 'Public.WithoutPaymentStatus a -> Handler () setTeamFeatureFlag tid status = do info $ msg "Setting team feature status"