Added TTL query field to features API.

changelog.d/1-api-changes/added-ttl-param-to-back-office-feature-api

@@ -0,0 +1 @@
+The back-office (aka stern) team feature API now accenpts an optional TTL parameter (in days), so features can be activated for a limited period.

libs/wire-api/src/Wire/API/Routes/Public/Galley.hs

@@ -1176,6 +1176,7 @@ type FeatureStatusBasePut errs featureName =
     :> "features"
     :> KnownTeamFeatureNameSymbol featureName
     :> ReqBody '[Servant.JSON] (TeamFeatureStatus 'WithoutLockStatus featureName)
+    :> QueryParam "ttl" TeamFeatureTTLValue
     :> Put '[Servant.JSON] (TeamFeatureStatus 'WithoutLockStatus featureName)
 
 -- | A type for a GET endpoint for a feature with a deprecated path

libs/wire-api/src/Wire/API/Team/Feature.hs

@@ -25,6 +25,7 @@ module Wire.API.Team.Feature
     TeamFeatureSelfDeletingMessagesConfig (..),
     TeamFeatureClassifiedDomainsConfig (..),
     TeamFeatureStatusValue (..),
+    TeamFeatureTTLValue (..),
     FeatureHasNoConfig,
     EnforceAppLock (..),
     KnownTeamFeatureName (..),
@@ -42,6 +43,7 @@ module Wire.API.Team.Feature
     -- * Swagger
     typeTeamFeatureName,
     typeTeamFeatureStatusValue,
+    typeTeamFeatureTTLValue,
     modelTeamFeatureStatusNoConfig,
     modelTeamFeatureStatusWithConfig,
     modelTeamFeatureAppLockConfig,
@@ -66,10 +68,11 @@ import qualified Data.Swagger as S
 import qualified Data.Swagger.Build.Api as Doc
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
+import qualified Data.Text.Lazy as TL
 import Deriving.Aeson
 import GHC.TypeLits (Symbol)
 import Imports
-import Servant (FromHttpApiData (..))
+import Servant (FromHttpApiData (..), Proxy (..), ToHttpApiData (..))
 import Test.QuickCheck.Arbitrary (arbitrary)
 import Wire.API.Arbitrary (Arbitrary, GenericUniform (..))
 
@@ -257,6 +260,60 @@ instance HasDeprecatedFeatureName 'TeamFeatureDigitalSignatures where
 typeTeamFeatureName :: Doc.DataType
 typeTeamFeatureName = Doc.string . Doc.enum $ cs . toByteString' <$> [(minBound :: TeamFeatureName) ..]
 
+----------------------------------------------------------------------
+-- TeamFeatureTTLValue
+
+-- Using Word to avoid dealing with negative numbers.
+-- Ideally we would also not support zero.
+-- Currently a TTL=0 is ignored on the cassandra side.
+data TeamFeatureTTLValue
+  = TeamFeatureTTLSeconds Word
+  | TeamFeatureTTLUnlimited
+  deriving stock (Eq, Show, Generic)
+  deriving (Arbitrary) via (GenericUniform TeamFeatureTTLValue)
+
+instance ToHttpApiData TeamFeatureTTLValue where
+  toQueryParam = T.decodeUtf8 . toByteString'
+
+instance FromHttpApiData TeamFeatureTTLValue where
+  parseQueryParam = maybeToEither invalidTTLErrorString . fromByteString . T.encodeUtf8
+
+instance S.ToParamSchema TeamFeatureTTLValue where
+  toParamSchema _ = S.toParamSchema (Proxy @Int)
+
+instance ToByteString TeamFeatureTTLValue where
+  builder TeamFeatureTTLUnlimited = "unlimited"
+  builder (TeamFeatureTTLSeconds d) = (builder . TL.pack . show) d
+
+instance FromByteString TeamFeatureTTLValue where
+  parser =
+    Parser.takeByteString >>= \b ->
+      case T.decodeUtf8' b of
+        Right "unlimited" -> pure TeamFeatureTTLUnlimited
+        Right d -> case readEither . T.unpack $ d of
+          Left _ -> fail $ T.unpack invalidTTLErrorString
+          Right d' -> pure . TeamFeatureTTLSeconds $ d'
+        Left _ -> fail $ T.unpack invalidTTLErrorString
+
+instance Cass.Cql TeamFeatureTTLValue where
+  ctype = Cass.Tagged Cass.IntColumn
+
+  -- Passing TTL = 0 to Cassandra removes the TTL.
+  -- It does not instantly revert back.
+  fromCql (Cass.CqlInt 0) = pure TeamFeatureTTLUnlimited
+  fromCql (Cass.CqlInt n) = pure . TeamFeatureTTLSeconds . fromIntegral $ n
+  fromCql _ = Left "fromCql: TTLValue: CqlInt expected"
+
+  toCql TeamFeatureTTLUnlimited = Cass.CqlInt 0
+  toCql (TeamFeatureTTLSeconds d) = Cass.CqlInt . fromIntegral $ d
+
+typeTeamFeatureTTLValue :: Doc.DataType
+typeTeamFeatureTTLValue =
+  Doc.int64'
+
+invalidTTLErrorString :: Text
+invalidTTLErrorString = "Invalid TeamFeatureTTLSeconds: must be a positive integer or 'unlimited.'"
+
 ----------------------------------------------------------------------
 -- TeamFeatureStatusValue
 

libs/wire-api/test/unit/Test/Wire/API/Roundtrip/ByteString.hs

@@ -66,6 +66,7 @@ tests =
       testRoundTrip @Push.V2.Token.Token,
       testRoundTrip @Team.Feature.TeamFeatureName,
       testRoundTrip @Team.Feature.TeamFeatureStatusValue,
+      testRoundTrip @Team.Feature.TeamFeatureTTLValue,
       testRoundTrip @User.Activation.ActivationCode,
       testRoundTrip @User.Activation.ActivationKey,
       testRoundTrip @User.Auth.CookieLabel,

services/galley/src/Galley/API/Internal.hs

@@ -407,11 +407,11 @@ featureAPI =
   fs getSSOStatusInternal setSSOStatusInternal
     <@> fs getLegalholdStatusInternal (setLegalholdStatusInternal @InternalPaging)
     <@> fs getTeamSearchVisibilityAvailableInternal setTeamSearchVisibilityAvailableInternal
-    <@> fs getTeamSearchVisibilityAvailableInternal setTeamSearchVisibilityAvailableInternal
-    <@> fs getValidateSAMLEmailsInternal setValidateSAMLEmailsInternal
+    <@> fsDeprecated getTeamSearchVisibilityAvailableInternal setTeamSearchVisibilityAvailableInternal
     <@> fs getValidateSAMLEmailsInternal setValidateSAMLEmailsInternal
+    <@> fsDeprecated getValidateSAMLEmailsInternal setValidateSAMLEmailsInternal
     <@> fs getDigitalSignaturesInternal setDigitalSignaturesInternal
-    <@> fs getDigitalSignaturesInternal setDigitalSignaturesInternal
+    <@> fsDeprecated getDigitalSignaturesInternal setDigitalSignaturesInternal
     <@> fs getAppLockInternal setAppLockInternal
     <@> ( fsGet getFileSharingInternal
             <@> fsSet setFileSharingInternal
@@ -435,11 +435,14 @@ featureAPI =
     <@> mkNamedAPI getTeamSearchVisibilityInboundInternalMulti
   where
     fs g s = fsGet g <@> fsSet s
+    fsDeprecated g s = fsGet g <@> fsSetDeprecated s
 
     fsGet g = mkNamedAPI (getFeatureStatus g DontDoAuth)
 
     fsSet s = mkNamedAPI (setFeatureStatus s DontDoAuth)
 
+    fsSetDeprecated s = mkNamedAPI (setFeatureStatusNoTTL s DontDoAuth)
+
 internalSitemap :: Routes a (Sem GalleyEffects) ()
 internalSitemap = do
   -- Conversation API (internal) ----------------------------------------

services/galley/src/Galley/API/Public/Servant.hs

@@ -142,7 +142,7 @@ servantSitemap =
               . DoAuth
           )
         <@> mkNamedAPI @'("put-deprecated", 'TeamFeatureSearchVisibility)
-          ( setFeatureStatus @'TeamFeatureSearchVisibility
+          ( setFeatureStatusNoTTL @'TeamFeatureSearchVisibility
               setTeamSearchVisibilityAvailableInternal
               . DoAuth
           )

services/galley/src/Galley/API/Teams/Features.hs

@@ -19,6 +19,7 @@ module Galley.API.Teams.Features
   ( getFeatureStatus,
     getFeatureStatusNoConfig,
     setFeatureStatus,
+    setFeatureStatusNoTTL,
     getFeatureConfig,
     getAllFeatureConfigsForUser,
     getAllFeatureConfigsForTeam,
@@ -113,6 +114,7 @@ type FeatureSetter f r =
     f
     ( TeamId ->
       TeamFeatureStatus 'WithoutLockStatus f ->
+      Maybe TeamFeatureTTLValue ->
       Sem r (TeamFeatureStatus 'WithoutLockStatus f)
     )
 
@@ -160,15 +162,37 @@ setFeatureStatus ::
   DoAuth ->
   TeamId ->
   TeamFeatureStatus 'WithoutLockStatus a ->
+  Maybe TeamFeatureTTLValue ->
   Sem r (TeamFeatureStatus 'WithoutLockStatus a)
-setFeatureStatus (Tagged setter) doauth tid status = do
+setFeatureStatus (Tagged setter) doauth tid status ttl = do
   case doauth of
     DoAuth uid -> do
       zusrMembership <- getTeamMember tid uid
       void $ permissionCheck ChangeTeamFeature zusrMembership
     DontDoAuth ->
       assertTeamExists tid
-  setter tid status
+  setter tid status ttl
+
+-- |  Does not support TTL.
+setFeatureStatusNoTTL ::
+  forall (a :: TeamFeatureName) r.
+  ( KnownTeamFeatureName a,
+    MaybeHasLockStatusCol a,
+    Members
+      '[ ErrorS 'NotATeamMember,
+         ErrorS OperationDenied,
+         ErrorS 'TeamNotFound,
+         TeamStore,
+         TeamFeatureStore
+       ]
+      r
+  ) =>
+  FeatureSetter a r ->
+  DoAuth ->
+  TeamId ->
+  TeamFeatureStatus 'WithoutLockStatus a ->
+  Sem r (TeamFeatureStatus 'WithoutLockStatus a)
+setFeatureStatusNoTTL setter doauth tid status = setFeatureStatus setter doauth tid status Nothing
 
 -- | Setting lock status can only be done through the internal API and therefore doesn't require auth.
 setLockStatus ::
@@ -308,11 +332,11 @@ setFeatureStatusNoConfig ::
     HasStatusCol a,
     Members '[GundeckAccess, TeamFeatureStore, TeamStore, P.TinyLog] r
   ) =>
-  (TeamFeatureStatusValue -> TeamId -> Sem r ()) ->
+  (TeamFeatureStatusValue -> TeamId -> Maybe TeamFeatureTTLValue -> Sem r ()) ->
   FeatureSetter a r
-setFeatureStatusNoConfig applyState = Tagged $ \tid status -> do
-  applyState (tfwoStatus status) tid
-  newStatus <- TeamFeatures.setFeatureStatusNoConfig @a tid status
+setFeatureStatusNoConfig applyState = Tagged $ \tid status ttl -> do
+  applyState (tfwoStatus status) tid ttl
+  newStatus <- TeamFeatures.setFeatureStatusNoConfig @a tid status ttl
   pushFeatureConfigEvent tid $
     Event.Event Event.Update (knownTeamFeatureName @a) (EdFeatureWithoutConfigChanged newStatus)
   pure newStatus
@@ -337,8 +361,8 @@ setSSOStatusInternal ::
   Members '[Error TeamFeatureError, GundeckAccess, TeamFeatureStore, TeamStore, P.TinyLog] r =>
   FeatureSetter 'TeamFeatureSSO r
 setSSOStatusInternal = setFeatureStatusNoConfig @'TeamFeatureSSO $ \case
-  TeamFeatureDisabled -> const (throw DisableSsoNotImplemented)
-  TeamFeatureEnabled -> const (pure ())
+  TeamFeatureDisabled -> const . const (throw DisableSsoNotImplemented)
+  TeamFeatureEnabled -> const . const (pure ())
 
 getTeamSearchVisibilityAvailableInternal ::
   Members '[Input Opts, TeamFeatureStore] r =>
@@ -358,8 +382,8 @@ setTeamSearchVisibilityAvailableInternal ::
   Members '[GundeckAccess, SearchVisibilityStore, TeamFeatureStore, TeamStore, P.TinyLog] r =>
   FeatureSetter 'TeamFeatureSearchVisibility r
 setTeamSearchVisibilityAvailableInternal = setFeatureStatusNoConfig @'TeamFeatureSearchVisibility $ \case
-  TeamFeatureDisabled -> SearchVisibilityData.resetSearchVisibility
-  TeamFeatureEnabled -> const (pure ())
+  TeamFeatureDisabled -> const . SearchVisibilityData.resetSearchVisibility
+  TeamFeatureEnabled -> const . const (pure ())
 
 getValidateSAMLEmailsInternal ::
   forall r.
@@ -378,7 +402,7 @@ getValidateSAMLEmailsInternal =
 setValidateSAMLEmailsInternal ::
   Members '[GundeckAccess, TeamFeatureStore, TeamStore, P.TinyLog] r =>
   FeatureSetter 'TeamFeatureValidateSAMLEmails r
-setValidateSAMLEmailsInternal = setFeatureStatusNoConfig @'TeamFeatureValidateSAMLEmails $ \_ _ -> pure ()
+setValidateSAMLEmailsInternal = setFeatureStatusNoConfig @'TeamFeatureValidateSAMLEmails $ \_ _ _ -> pure ()
 
 getDigitalSignaturesInternal ::
   Member TeamFeatureStore r =>
@@ -397,7 +421,7 @@ getDigitalSignaturesInternal =
 setDigitalSignaturesInternal ::
   Members '[GundeckAccess, TeamFeatureStore, TeamStore, P.TinyLog] r =>
   FeatureSetter 'TeamFeatureDigitalSignatures r
-setDigitalSignaturesInternal = setFeatureStatusNoConfig @'TeamFeatureDigitalSignatures $ \_ _ -> pure ()
+setDigitalSignaturesInternal = setFeatureStatusNoConfig @'TeamFeatureDigitalSignatures $ \_ _ _ -> pure ()
 
 getLegalholdStatusInternal ::
   Members '[LegalHoldStore, TeamFeatureStore, TeamStore] r =>
@@ -447,7 +471,7 @@ setLegalholdStatusInternal ::
       r
   ) =>
   FeatureSetter 'TeamFeatureLegalHold r
-setLegalholdStatusInternal = Tagged $ \tid status@(tfwoStatus -> statusValue) -> do
+setLegalholdStatusInternal = Tagged $ \tid status@(tfwoStatus -> statusValue) ttl -> do
   do
     -- this extra do is to encapsulate the assertions running before the actual operation.
     -- enabling LH for teams is only allowed in normal operation; disabled-permanently and
@@ -465,7 +489,7 @@ setLegalholdStatusInternal = Tagged $ \tid status@(tfwoStatus -> statusValue) ->
   case statusValue of
     TeamFeatureDisabled -> removeSettings' @p tid
     TeamFeatureEnabled -> ensureNotTooLargeToActivateLegalHold tid
-  TeamFeatures.setFeatureStatusNoConfig @'TeamFeatureLegalHold tid status
+  TeamFeatures.setFeatureStatusNoConfig @'TeamFeatureLegalHold tid status ttl
 
 getFileSharingInternal ::
   forall r.
@@ -527,7 +551,7 @@ setFileSharingInternal ::
     Member (Input Opts) r
   ) =>
   FeatureSetter 'TeamFeatureFileSharing r
-setFileSharingInternal = Tagged $ \tid status -> do
+setFileSharingInternal = Tagged $ \tid status ttl -> do
   getDftLockStatus >>= guardLockStatus @'TeamFeatureFileSharing tid
   let pushEvent =
         pushFeatureConfigEvent tid $
@@ -537,7 +561,7 @@ setFileSharingInternal = Tagged $ \tid status -> do
             ( EdFeatureWithoutConfigAndLockStatusChanged
                 (TeamFeatureStatusNoConfigAndLockStatus (tfwoStatus status) Unlocked)
             )
-  TeamFeatures.setFeatureStatusNoConfig @'TeamFeatureFileSharing tid status <* pushEvent
+  TeamFeatures.setFeatureStatusNoConfig @'TeamFeatureFileSharing tid status ttl <* pushEvent
   where
     getDftLockStatus :: Sem r LockStatusValue
     getDftLockStatus = input <&> view (optSettings . setFeatureFlags . flagFileSharing . unDefaults . to tfwoapsLockStatus)
@@ -559,7 +583,7 @@ getAppLockInternal = Tagged $ \case
 setAppLockInternal ::
   Members '[GundeckAccess, TeamFeatureStore, TeamStore, Error TeamFeatureError, P.TinyLog] r =>
   FeatureSetter 'TeamFeatureAppLock r
-setAppLockInternal = Tagged $ \tid status -> do
+setAppLockInternal = Tagged $ \tid status _ttl -> do
   when (applockInactivityTimeoutSecs (tfwcConfig status) < 30) $
     throw AppLockInactivityTimeoutTooLow
   let pushEvent =
@@ -589,7 +613,7 @@ setConferenceCallingInternal ::
   Members '[GundeckAccess, TeamFeatureStore, TeamStore, P.TinyLog] r =>
   FeatureSetter 'TeamFeatureConferenceCalling r
 setConferenceCallingInternal =
-  setFeatureStatusNoConfig @'TeamFeatureConferenceCalling $ \_status _tid -> pure ()
+  setFeatureStatusNoConfig @'TeamFeatureConferenceCalling $ \_status _tid _ttl -> pure ()
 
 getSelfDeletingMessagesInternal ::
   forall r.
@@ -626,7 +650,7 @@ setSelfDeletingMessagesInternal ::
     Member (Input Opts) r
   ) =>
   FeatureSetter 'TeamFeatureSelfDeletingMessages r
-setSelfDeletingMessagesInternal = Tagged $ \tid st -> do
+setSelfDeletingMessagesInternal = Tagged $ \tid st _ -> do
   getDftLockStatus >>= guardLockStatus @'TeamFeatureSelfDeletingMessages tid
   let pushEvent =
         pushFeatureConfigEvent tid $
@@ -661,7 +685,7 @@ setGuestLinkInternal ::
     Member (Input Opts) r
   ) =>
   FeatureSetter 'TeamFeatureGuestLinks r
-setGuestLinkInternal = Tagged $ \tid status -> do
+setGuestLinkInternal = Tagged $ \tid status ttl -> do
   getDftLockStatus >>= guardLockStatus @'TeamFeatureGuestLinks tid
   let pushEvent =
         pushFeatureConfigEvent tid $
@@ -671,7 +695,7 @@ setGuestLinkInternal = Tagged $ \tid status -> do
             ( EdFeatureWithoutConfigAndLockStatusChanged
                 (TeamFeatureStatusNoConfigAndLockStatus (tfwoStatus status) Unlocked)
             )
-  TeamFeatures.setFeatureStatusNoConfig @'TeamFeatureGuestLinks tid status <* pushEvent
+  TeamFeatures.setFeatureStatusNoConfig @'TeamFeatureGuestLinks tid status ttl <* pushEvent
   where
     getDftLockStatus :: Sem r LockStatusValue
     getDftLockStatus = input <&> view (optSettings . setFeatureFlags . flagConversationGuestLinks . unDefaults . to tfwoapsLockStatus)
@@ -758,7 +782,7 @@ setSndFactorPasswordChallengeInternal ::
     Member (Input Opts) r
   ) =>
   FeatureSetter 'TeamFeatureSndFactorPasswordChallenge r
-setSndFactorPasswordChallengeInternal = Tagged $ \tid status -> do
+setSndFactorPasswordChallengeInternal = Tagged $ \tid status ttl -> do
   getDftLockStatus >>= guardLockStatus @'TeamFeatureSndFactorPasswordChallenge tid
   let pushEvent =
         pushFeatureConfigEvent tid $
@@ -768,7 +792,7 @@ setSndFactorPasswordChallengeInternal = Tagged $ \tid status -> do
             ( EdFeatureWithoutConfigAndLockStatusChanged
                 (TeamFeatureStatusNoConfigAndLockStatus (tfwoStatus status) Unlocked)
             )
-  TeamFeatures.setFeatureStatusNoConfig @'TeamFeatureSndFactorPasswordChallenge tid status <* pushEvent
+  TeamFeatures.setFeatureStatusNoConfig @'TeamFeatureSndFactorPasswordChallenge tid status ttl <* pushEvent
   where
     getDftLockStatus :: Sem r LockStatusValue
     getDftLockStatus = input <&> view (optSettings . setFeatureFlags . flagTeamFeatureSndFactorPasswordChallengeStatus . unDefaults . to tfwoapsLockStatus)
@@ -785,8 +809,8 @@ getTeamSearchVisibilityInboundInternal =
 setTeamSearchVisibilityInboundInternal ::
   Members '[Error InternalError, GundeckAccess, TeamStore, TeamFeatureStore, BrigAccess, P.TinyLog] r =>
   FeatureSetter 'TeamFeatureSearchVisibilityInbound r
-setTeamSearchVisibilityInboundInternal = Tagged $ \tid status -> do
-  updatedStatus <- unTagged (setFeatureStatusNoConfig @'TeamFeatureSearchVisibilityInbound $ \_ _ -> pure ()) tid status
+setTeamSearchVisibilityInboundInternal = Tagged $ \tid status ttl -> do
+  updatedStatus <- unTagged (setFeatureStatusNoConfig @'TeamFeatureSearchVisibilityInbound $ \_ _ _ -> pure ()) tid status ttl
   mPersistedStatus <- listToMaybe <$> TeamFeatures.getFeatureStatusNoConfigMulti (Proxy @'TeamFeatureSearchVisibilityInbound) [tid]
   case mPersistedStatus of
     Just (persistedTid, persistedStatus, persistedWriteTime) ->