Added TTL to endpoint responses on feature status.

Author: elland

libs/wire-api/package.yaml

@@ -66,19 +66,20 @@ library:
   - mtl
   - pem >=0.2
   - polysemy
-  - protobuf >=0.2
   - proto-lens
+  - protobuf >=0.2
   - QuickCheck >=2.14
   - quickcheck-instances >=0.3.16
   - random >=1.2.0
   - resourcet
+  - schema-profunctor
+  - scientific
   - servant-client
   - servant-client-core
   - servant-conduit
   - servant-multipart
   - servant-server
   - servant-swagger
-  - schema-profunctor
   - singletons
   - sop-core
   - string-conversions
@@ -92,13 +93,13 @@ library:
   - utf8-string
   - uuid >=1.3
   - vector >= 0.12
-  - wire-message-proto-lens
-  - x509
   - wai
   - wai-extra
   - wai-utilities
   - wai-websockets
   - websockets
+  - wire-message-proto-lens
+  - x509
 
 tests:
   wire-api-tests:

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

@@ -67,6 +67,7 @@ where
 import qualified Cassandra.CQL as Cass
 import Control.Lens (makeLenses, (?~))
 import qualified Data.Aeson as A
+import qualified Data.Aeson.Types as A
 import qualified Data.Attoparsec.ByteString as Parser
 import Data.ByteString.Conversion
 import qualified Data.ByteString.UTF8 as UTF8
@@ -75,6 +76,7 @@ import Data.Either.Extra (maybeToEither)
 import Data.Id
 import Data.Proxy
 import Data.Schema
+import Data.Scientific (toBoundedInteger)
 import Data.String.Conversions (cs)
 import qualified Data.Swagger as S
 import qualified Data.Swagger.Build.Api as Doc
@@ -162,13 +164,14 @@ featureNameBS = UTF8.fromString $ symbolVal (Proxy @(FeatureSymbol cfg))
 data WithStatus (cfg :: *) = WithStatus
   { wsStatus :: FeatureStatus,
     wsLockStatus :: LockStatus,
-    wsConfig :: cfg
+    wsConfig :: cfg,
+    wsTTL :: FeatureTTL
   }
   deriving stock (Eq, Show, Generic, Typeable, Functor)
   deriving (ToJSON, FromJSON, S.ToSchema) via (Schema (WithStatus cfg))
 
 instance Arbitrary cfg => Arbitrary (WithStatus cfg) where
-  arbitrary = WithStatus <$> arbitrary <*> arbitrary <*> arbitrary
+  arbitrary = WithStatus <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
 
 instance (ToSchema cfg, IsFeatureConfig cfg) => ToSchema (WithStatus cfg) where
   schema =
@@ -177,6 +180,7 @@ instance (ToSchema cfg, IsFeatureConfig cfg) => ToSchema (WithStatus cfg) where
         <$> wsStatus .= field "status" schema
         <*> wsLockStatus .= field "lockStatus" schema
         <*> wsConfig .= objectSchema @cfg
+        <*> wsTTL .= field "ttl" schema
     where
       inner = schema @cfg
       name = fromMaybe "" (getName (schemaDoc inner)) <> ".WithStatus"
@@ -200,19 +204,20 @@ withStatusModel =
 
 data WithStatusNoLock (cfg :: *) = WithStatusNoLock
   { wssStatus :: FeatureStatus,
-    wssConfig :: cfg
+    wssConfig :: cfg,
+    wssTTL :: FeatureTTL
   }
   deriving stock (Eq, Show, Generic, Typeable, Functor)
   deriving (ToJSON, FromJSON, S.ToSchema) via (Schema (WithStatusNoLock cfg))
 
 instance Arbitrary cfg => Arbitrary (WithStatusNoLock cfg) where
-  arbitrary = WithStatusNoLock <$> arbitrary <*> arbitrary
+  arbitrary = WithStatusNoLock <$> arbitrary <*> arbitrary <*> arbitrary
 
 forgetLock :: WithStatus a -> WithStatusNoLock a
-forgetLock WithStatus {..} = WithStatusNoLock wsStatus wsConfig
+forgetLock WithStatus {..} = WithStatusNoLock wsStatus wsConfig wsTTL
 
 withLockStatus :: LockStatus -> WithStatusNoLock a -> WithStatus a
-withLockStatus ls (WithStatusNoLock s c) = WithStatus s ls c
+withLockStatus ls (WithStatusNoLock s c ttl) = WithStatus s ls c ttl
 
 withUnlocked :: WithStatusNoLock a -> WithStatus a
 withUnlocked = withLockStatus LockStatusUnlocked
@@ -226,6 +231,7 @@ instance (ToSchema cfg, IsFeatureConfig cfg) => ToSchema (WithStatusNoLock cfg)
       WithStatusNoLock
         <$> wssStatus .= field "status" schema
         <*> wssConfig .= objectSchema @cfg
+        <*> wssTTL .= field "ttl" schema
     where
       inner = schema @cfg
       name = fromMaybe "" (getName (schemaDoc inner)) <> ".WithStatusNoLock"
@@ -255,6 +261,35 @@ data FeatureTTL
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform FeatureTTL)
 
+instance ToSchema FeatureTTL where
+  schema = mkSchema ttlDoc toTTL fromTTL
+    where
+      ttlDoc :: NamedSwaggerDoc
+      ttlDoc = swaggerDoc @Word & S.schema . S.example ?~ "unlimited"
+
+      toTTL :: A.Value -> A.Parser FeatureTTL
+      toTTL v = parseUnlimited v <|> parseSeconds v
+
+      parseUnlimited :: A.Value -> A.Parser FeatureTTL
+      parseUnlimited =
+        A.withText "FeatureTTL" $
+          \t ->
+            if t == "unlimited" || t == "0"
+              then pure FeatureTTLUnlimited
+              else A.parseFail "Expected ''unlimited' or '0'."
+
+      parseSeconds :: A.Value -> A.Parser FeatureTTL
+      parseSeconds = A.withScientific "FeatureTTL" $
+        \s -> case toBoundedInteger s of
+          Just 0 -> pure FeatureTTLUnlimited
+          Just i -> pure . FeatureTTLSeconds $ i
+          Nothing -> A.parseFail "Expected an integer."
+
+      fromTTL :: FeatureTTL -> Maybe A.Value
+      fromTTL FeatureTTLUnlimited = Just "unlimited"
+      fromTTL (FeatureTTLSeconds 0) = Just "unlimited"
+      fromTTL (FeatureTTLSeconds s) = A.decode . toByteString $ s
+
 instance ToHttpApiData FeatureTTL where
   toQueryParam = T.decodeUtf8 . toByteString'
 
@@ -441,7 +476,7 @@ instance ToSchema GuestLinksConfig where
 
 instance IsFeatureConfig GuestLinksConfig where
   type FeatureSymbol GuestLinksConfig = "conversationGuestLinks"
-  defFeatureStatus = WithStatus FeatureStatusEnabled LockStatusUnlocked GuestLinksConfig
+  defFeatureStatus = WithStatus FeatureStatusEnabled LockStatusUnlocked GuestLinksConfig FeatureTTLUnlimited
   objectSchema = pure GuestLinksConfig
 
 instance FeatureTrivialConfig GuestLinksConfig where
@@ -456,7 +491,7 @@ data LegalholdConfig = LegalholdConfig
 
 instance IsFeatureConfig LegalholdConfig where
   type FeatureSymbol LegalholdConfig = "legalhold"
-  defFeatureStatus = WithStatus FeatureStatusDisabled LockStatusUnlocked LegalholdConfig
+  defFeatureStatus = WithStatus FeatureStatusDisabled LockStatusUnlocked LegalholdConfig FeatureTTLUnlimited
   objectSchema = pure LegalholdConfig
 
 instance ToSchema LegalholdConfig where
@@ -474,7 +509,7 @@ data SSOConfig = SSOConfig
 
 instance IsFeatureConfig SSOConfig where
   type FeatureSymbol SSOConfig = "sso"
-  defFeatureStatus = WithStatus FeatureStatusDisabled LockStatusUnlocked SSOConfig
+  defFeatureStatus = WithStatus FeatureStatusDisabled LockStatusUnlocked SSOConfig FeatureTTLUnlimited
   objectSchema = pure SSOConfig
 
 instance ToSchema SSOConfig where
@@ -494,7 +529,7 @@ data SearchVisibilityAvailableConfig = SearchVisibilityAvailableConfig
 
 instance IsFeatureConfig SearchVisibilityAvailableConfig where
   type FeatureSymbol SearchVisibilityAvailableConfig = "searchVisibility"
-  defFeatureStatus = WithStatus FeatureStatusDisabled LockStatusUnlocked SearchVisibilityAvailableConfig
+  defFeatureStatus = WithStatus FeatureStatusDisabled LockStatusUnlocked SearchVisibilityAvailableConfig FeatureTTLUnlimited
   objectSchema = pure SearchVisibilityAvailableConfig
 
 instance ToSchema SearchVisibilityAvailableConfig where
@@ -518,7 +553,7 @@ instance ToSchema ValidateSAMLEmailsConfig where
 
 instance IsFeatureConfig ValidateSAMLEmailsConfig where
   type FeatureSymbol ValidateSAMLEmailsConfig = "validateSAMLemails"
-  defFeatureStatus = WithStatus FeatureStatusEnabled LockStatusUnlocked ValidateSAMLEmailsConfig
+  defFeatureStatus = WithStatus FeatureStatusEnabled LockStatusUnlocked ValidateSAMLEmailsConfig FeatureTTLUnlimited
   objectSchema = pure ValidateSAMLEmailsConfig
 
 instance HasDeprecatedFeatureName ValidateSAMLEmailsConfig where
@@ -536,7 +571,7 @@ data DigitalSignaturesConfig = DigitalSignaturesConfig
 
 instance IsFeatureConfig DigitalSignaturesConfig where
   type FeatureSymbol DigitalSignaturesConfig = "digitalSignatures"
-  defFeatureStatus = WithStatus FeatureStatusDisabled LockStatusUnlocked DigitalSignaturesConfig
+  defFeatureStatus = WithStatus FeatureStatusDisabled LockStatusUnlocked DigitalSignaturesConfig FeatureTTLUnlimited
   objectSchema = pure DigitalSignaturesConfig
 
 instance HasDeprecatedFeatureName DigitalSignaturesConfig where
@@ -557,7 +592,7 @@ data ConferenceCallingConfig = ConferenceCallingConfig
 
 instance IsFeatureConfig ConferenceCallingConfig where
   type FeatureSymbol ConferenceCallingConfig = "conferenceCalling"
-  defFeatureStatus = WithStatus FeatureStatusEnabled LockStatusUnlocked ConferenceCallingConfig
+  defFeatureStatus = WithStatus FeatureStatusEnabled LockStatusUnlocked ConferenceCallingConfig FeatureTTLUnlimited
   objectSchema = pure ConferenceCallingConfig
 
 instance ToSchema ConferenceCallingConfig where
@@ -578,7 +613,7 @@ instance ToSchema SndFactorPasswordChallengeConfig where
 
 instance IsFeatureConfig SndFactorPasswordChallengeConfig where
   type FeatureSymbol SndFactorPasswordChallengeConfig = "sndFactorPasswordChallenge"
-  defFeatureStatus = WithStatus FeatureStatusDisabled LockStatusLocked SndFactorPasswordChallengeConfig
+  defFeatureStatus = WithStatus FeatureStatusDisabled LockStatusLocked SndFactorPasswordChallengeConfig FeatureTTLUnlimited
   objectSchema = pure SndFactorPasswordChallengeConfig
 
 instance FeatureTrivialConfig SndFactorPasswordChallengeConfig where
@@ -593,7 +628,7 @@ data SearchVisibilityInboundConfig = SearchVisibilityInboundConfig
 
 instance IsFeatureConfig SearchVisibilityInboundConfig where
   type FeatureSymbol SearchVisibilityInboundConfig = "searchVisibilityInbound"
-  defFeatureStatus = WithStatus FeatureStatusDisabled LockStatusUnlocked SearchVisibilityInboundConfig
+  defFeatureStatus = WithStatus FeatureStatusDisabled LockStatusUnlocked SearchVisibilityInboundConfig FeatureTTLUnlimited
   objectSchema = pure SearchVisibilityInboundConfig
 
 instance ToSchema SearchVisibilityInboundConfig where
@@ -626,6 +661,7 @@ instance IsFeatureConfig ClassifiedDomainsConfig where
       FeatureStatusDisabled
       LockStatusUnlocked
       (ClassifiedDomainsConfig [])
+      FeatureTTLUnlimited
   configModel = Just $
     Doc.defineModel "ClassifiedDomainsConfig" $ do
       Doc.property "domains" (Doc.array Doc.string') $ Doc.description "domains"
@@ -656,6 +692,7 @@ instance IsFeatureConfig AppLockConfig where
       FeatureStatusEnabled
       LockStatusUnlocked
       (AppLockConfig (EnforceAppLock False) 60)
+      FeatureTTLUnlimited
   configModel = Just $
     Doc.defineModel "AppLockConfig" $ do
       Doc.property "enforceAppLock" Doc.bool' $ Doc.description "enforceAppLock"
@@ -679,7 +716,7 @@ data FileSharingConfig = FileSharingConfig
 
 instance IsFeatureConfig FileSharingConfig where
   type FeatureSymbol FileSharingConfig = "fileSharing"
-  defFeatureStatus = WithStatus FeatureStatusEnabled LockStatusUnlocked FileSharingConfig
+  defFeatureStatus = WithStatus FeatureStatusEnabled LockStatusUnlocked FileSharingConfig FeatureTTLUnlimited
   objectSchema = pure FileSharingConfig
 
 instance ToSchema FileSharingConfig where
@@ -711,6 +748,7 @@ instance IsFeatureConfig SelfDeletingMessagesConfig where
       FeatureStatusEnabled
       LockStatusUnlocked
       (SelfDeletingMessagesConfig 0)
+      FeatureTTLUnlimited
   configModel = Just $
     Doc.defineModel "SelfDeletingMessagesConfig" $ do
       Doc.property "enforcedTimeoutSeconds" Doc.int32' $ Doc.description "optional; default: `0` (no enforcement)"
@@ -741,7 +779,7 @@ instance IsFeatureConfig MLSConfig where
   type FeatureSymbol MLSConfig = "mls"
   defFeatureStatus =
     let config = MLSConfig [] ProtocolProteusTag [MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519] MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519
-     in WithStatus FeatureStatusDisabled LockStatusUnlocked config
+     in WithStatus FeatureStatusDisabled LockStatusUnlocked config FeatureTTLUnlimited
   objectSchema = field "config" schema
   configModel = Just $
     Doc.defineModel "MLSConfig" $ do

libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatusNoLock_team.hs

@@ -24,52 +24,52 @@ import Imports
 import Wire.API.Team.Feature
 
 testObject_WithStatusNoLock_team_1 :: WithStatusNoLock AppLockConfig
-testObject_WithStatusNoLock_team_1 = WithStatusNoLock FeatureStatusEnabled (AppLockConfig (EnforceAppLock False) (-98))
+testObject_WithStatusNoLock_team_1 = WithStatusNoLock FeatureStatusEnabled (AppLockConfig (EnforceAppLock False) (-98)) FeatureTTLUnlimited
 
 testObject_WithStatusNoLock_team_2 :: WithStatusNoLock AppLockConfig
-testObject_WithStatusNoLock_team_2 = WithStatusNoLock FeatureStatusEnabled (AppLockConfig (EnforceAppLock True) 0)
+testObject_WithStatusNoLock_team_2 = WithStatusNoLock FeatureStatusEnabled (AppLockConfig (EnforceAppLock True) 0) FeatureTTLUnlimited
 
 testObject_WithStatusNoLock_team_3 :: WithStatusNoLock AppLockConfig
-testObject_WithStatusNoLock_team_3 = WithStatusNoLock FeatureStatusEnabled (AppLockConfig (EnforceAppLock True) 111)
+testObject_WithStatusNoLock_team_3 = WithStatusNoLock FeatureStatusEnabled (AppLockConfig (EnforceAppLock True) 111) FeatureTTLUnlimited
 
 testObject_WithStatusNoLock_team_4 :: WithStatusNoLock SelfDeletingMessagesConfig
-testObject_WithStatusNoLock_team_4 = WithStatusNoLock FeatureStatusEnabled (SelfDeletingMessagesConfig (-97))
+testObject_WithStatusNoLock_team_4 = WithStatusNoLock FeatureStatusEnabled (SelfDeletingMessagesConfig (-97)) FeatureTTLUnlimited
 
 testObject_WithStatusNoLock_team_5 :: WithStatusNoLock SelfDeletingMessagesConfig
-testObject_WithStatusNoLock_team_5 = WithStatusNoLock FeatureStatusEnabled (SelfDeletingMessagesConfig 0)
+testObject_WithStatusNoLock_team_5 = WithStatusNoLock FeatureStatusEnabled (SelfDeletingMessagesConfig 0) FeatureTTLUnlimited
 
 testObject_WithStatusNoLock_team_6 :: WithStatusNoLock SelfDeletingMessagesConfig
-testObject_WithStatusNoLock_team_6 = WithStatusNoLock FeatureStatusEnabled (SelfDeletingMessagesConfig 77)
+testObject_WithStatusNoLock_team_6 = WithStatusNoLock FeatureStatusEnabled (SelfDeletingMessagesConfig 77) FeatureTTLUnlimited
 
 testObject_WithStatusNoLock_team_7 :: WithStatusNoLock ClassifiedDomainsConfig
-testObject_WithStatusNoLock_team_7 = WithStatusNoLock FeatureStatusEnabled (ClassifiedDomainsConfig [])
+testObject_WithStatusNoLock_team_7 = WithStatusNoLock FeatureStatusEnabled (ClassifiedDomainsConfig []) FeatureTTLUnlimited
 
 testObject_WithStatusNoLock_team_8 :: WithStatusNoLock ClassifiedDomainsConfig
-testObject_WithStatusNoLock_team_8 = WithStatusNoLock FeatureStatusEnabled (ClassifiedDomainsConfig [Domain "example.com", Domain "test.foobar"])
+testObject_WithStatusNoLock_team_8 = WithStatusNoLock FeatureStatusEnabled (ClassifiedDomainsConfig [Domain "example.com", Domain "test.foobar"]) FeatureTTLUnlimited
 
 testObject_WithStatusNoLock_team_9 :: WithStatusNoLock ClassifiedDomainsConfig
-testObject_WithStatusNoLock_team_9 = WithStatusNoLock FeatureStatusEnabled (ClassifiedDomainsConfig [Domain "test.foobar"])
+testObject_WithStatusNoLock_team_9 = WithStatusNoLock FeatureStatusEnabled (ClassifiedDomainsConfig [Domain "test.foobar"]) FeatureTTLUnlimited
 
 testObject_WithStatusNoLock_team_10 :: WithStatusNoLock SSOConfig
-testObject_WithStatusNoLock_team_10 = WithStatusNoLock FeatureStatusDisabled SSOConfig
+testObject_WithStatusNoLock_team_10 = WithStatusNoLock FeatureStatusDisabled SSOConfig FeatureTTLUnlimited
 
 testObject_WithStatusNoLock_team_11 :: WithStatusNoLock SearchVisibilityAvailableConfig
-testObject_WithStatusNoLock_team_11 = WithStatusNoLock FeatureStatusEnabled SearchVisibilityAvailableConfig
+testObject_WithStatusNoLock_team_11 = WithStatusNoLock FeatureStatusEnabled SearchVisibilityAvailableConfig FeatureTTLUnlimited
 
 testObject_WithStatusNoLock_team_12 :: WithStatusNoLock ValidateSAMLEmailsConfig
-testObject_WithStatusNoLock_team_12 = WithStatusNoLock FeatureStatusDisabled ValidateSAMLEmailsConfig
+testObject_WithStatusNoLock_team_12 = WithStatusNoLock FeatureStatusDisabled ValidateSAMLEmailsConfig FeatureTTLUnlimited
 
 testObject_WithStatusNoLock_team_13 :: WithStatusNoLock DigitalSignaturesConfig
-testObject_WithStatusNoLock_team_13 = WithStatusNoLock FeatureStatusEnabled DigitalSignaturesConfig
+testObject_WithStatusNoLock_team_13 = WithStatusNoLock FeatureStatusEnabled DigitalSignaturesConfig FeatureTTLUnlimited
 
 testObject_WithStatusNoLock_team_14 :: WithStatusNoLock ConferenceCallingConfig
-testObject_WithStatusNoLock_team_14 = WithStatusNoLock FeatureStatusDisabled ConferenceCallingConfig
+testObject_WithStatusNoLock_team_14 = WithStatusNoLock FeatureStatusDisabled ConferenceCallingConfig FeatureTTLUnlimited
 
 testObject_WithStatusNoLock_team_15 :: WithStatusNoLock GuestLinksConfig
-testObject_WithStatusNoLock_team_15 = WithStatusNoLock FeatureStatusEnabled GuestLinksConfig
+testObject_WithStatusNoLock_team_15 = WithStatusNoLock FeatureStatusEnabled GuestLinksConfig FeatureTTLUnlimited
 
 testObject_WithStatusNoLock_team_16 :: WithStatusNoLock SndFactorPasswordChallengeConfig
-testObject_WithStatusNoLock_team_16 = WithStatusNoLock FeatureStatusDisabled SndFactorPasswordChallengeConfig
+testObject_WithStatusNoLock_team_16 = WithStatusNoLock FeatureStatusDisabled SndFactorPasswordChallengeConfig FeatureTTLUnlimited
 
 testObject_WithStatusNoLock_team_17 :: WithStatusNoLock SearchVisibilityInboundConfig
-testObject_WithStatusNoLock_team_17 = WithStatusNoLock FeatureStatusEnabled SearchVisibilityInboundConfig
+testObject_WithStatusNoLock_team_17 = WithStatusNoLock FeatureStatusEnabled SearchVisibilityInboundConfig FeatureTTLUnlimited