diff --git a/integration/test/Test/Client.hs b/integration/test/Test/Client.hs index b5b117d7a7d..8c3101737dd 100644 --- a/integration/test/Test/Client.hs +++ b/integration/test/Test/Client.hs @@ -103,3 +103,21 @@ testUpdateClientWithConsumableNotificationsCapability = do getSelfClients alice `bindResponse` \resp -> do resp.status `shouldMatchInt` 200 resp.json %. "0.capabilities" `shouldMatch` [consumeCapability] + +testGetClientCapabilitiesV6 :: App () +testGetClientCapabilitiesV6 = do + let allCapabilities = ["legalhold-implicit-consent", "consumable-notifications"] + alice <- randomUser OwnDomain def + addClient alice def {acapabilities = Just allCapabilities} `bindResponse` \resp -> do + resp.status `shouldMatchInt` 201 + resp.json %. "capabilities" `shouldMatchSet` allCapabilities + + getSelfClients alice `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "0.capabilities" `shouldMatchSet` allCapabilities + + -- In API v6 and below, the "capabilities" field is an enum, so having a new + -- value for this enum is a breaking change. + withAPIVersion 6 $ getSelfClients alice `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "0.capabilities.capabilities" `shouldMatchSet` ["legalhold-implicit-consent"] diff --git a/libs/wire-api/src/Wire/API/User/Client.hs b/libs/wire-api/src/Wire/API/User/Client.hs index d1ab7237a03..683417c0d6b 100644 --- a/libs/wire-api/src/Wire/API/User/Client.hs +++ b/libs/wire-api/src/Wire/API/User/Client.hs @@ -177,21 +177,27 @@ newtype ClientCapabilityList = ClientCapabilityList {fromClientCapabilityList :: deriving (ToJSON, FromJSON, Swagger.ToSchema) via (Schema ClientCapabilityList) instance ToSchema ClientCapabilityList where + schema = capabilitiesSchema Nothing + +instance ToSchema (Versioned V6 ClientCapabilityList) where schema = - object "ClientCapabilityList" $ - ClientCapabilityList <$> fromClientCapabilityList .= fmap runIdentity capabilitiesFieldSchema - -capabilitiesFieldSchema :: - (FieldFunctor SwaggerDoc f) => - ObjectSchemaP SwaggerDoc (Set ClientCapability) (f (Set ClientCapability)) -capabilitiesFieldSchema = - Set.toList - .= fieldWithDocModifierF "capabilities" mods (Set.fromList <$> array schema) + object "ClientCapabilityListV6" $ + Versioned + <$> unVersioned .= field "capabilities" (capabilitiesSchema (Just V6)) + +capabilitiesSchema :: + Maybe Version -> + ValueSchema NamedSwaggerDoc ClientCapabilityList +capabilitiesSchema mVersion = + named "ClientCapabilityList" $ + ClientCapabilityList + <$> (Set.toList . dropIncompatibleCapabilities . fromClientCapabilityList) .= (Set.fromList <$> array schema) where - mods = - description - ?~ "Hints provided by the client for the backend so it can \ - \behave in a backwards-compatible way." + dropIncompatibleCapabilities :: Set ClientCapability -> Set ClientCapability + dropIncompatibleCapabilities caps = + case mVersion of + Just v | v <= V6 -> Set.delete ClientSupportsConsumableNotifications caps + _ -> caps -------------------------------------------------------------------------------- -- UserClientMap @@ -504,7 +510,7 @@ mlsPublicKeysSchema = mapSchema = map_ base64Schema clientSchema :: Maybe Version -> ValueSchema NamedSwaggerDoc Client -clientSchema mv = +clientSchema mVersion = object "Client" $ Client <$> clientId .= field "id" schema @@ -514,15 +520,17 @@ clientSchema mv = <*> clientLabel .= maybe_ (optField "label" schema) <*> clientCookie .= maybe_ (optField "cookie" schema) <*> clientModel .= maybe_ (optField "model" schema) - <*> clientCapabilities .= (fromMaybe mempty <$> caps) + <*> clientCapabilities .= (fromMaybe mempty <$> optField "capabilities" caps) <*> clientMLSPublicKeys .= mlsPublicKeysFieldSchema <*> clientLastActive .= maybe_ (optField "last_active" utcTimeSchema) where - caps :: ObjectSchemaP SwaggerDoc ClientCapabilityList (Maybe ClientCapabilityList) - caps = case mv of + caps :: ValueSchema NamedSwaggerDoc ClientCapabilityList + caps = case mVersion of -- broken capability serialisation for backwards compatibility - Just v | v <= V6 -> optField "capabilities" schema - _ -> fmap ClientCapabilityList <$> fromClientCapabilityList .= capabilitiesFieldSchema + Just v + | v <= V6 -> + dimap Versioned unVersioned $ schema @(Versioned V6 ClientCapabilityList) + _ -> schema @ClientCapabilityList instance ToSchema Client where schema = clientSchema Nothing @@ -666,7 +674,7 @@ data NewClient = NewClient newClientCookie :: Maybe CookieLabel, newClientPassword :: Maybe PlainTextPassword6, newClientModel :: Maybe Text, - newClientCapabilities :: Maybe (Set ClientCapability), + newClientCapabilities :: Maybe ClientCapabilityList, newClientMLSPublicKeys :: MLSPublicKeys, newClientVerificationCode :: Maybe Code.Value } @@ -730,7 +738,16 @@ instance ToSchema NewClient where schema ) <*> newClientModel .= maybe_ (optField "model" schema) - <*> newClientCapabilities .= maybe_ capabilitiesFieldSchema + <*> newClientCapabilities + .= maybe_ + ( optFieldWithDocModifier + "capabilities" + ( description + ?~ "Hints provided by the client for the backend so it can \ + \behave in a backwards-compatible way." + ) + schema + ) <*> newClientMLSPublicKeys .= mlsPublicKeysFieldSchema <*> newClientVerificationCode .= maybe_ (optField "verification_code" schema) @@ -758,7 +775,7 @@ data UpdateClient = UpdateClient updateClientLastKey :: Maybe LastPrekey, updateClientLabel :: Maybe Text, -- | see haddocks for 'ClientCapability' - updateClientCapabilities :: Maybe (Set ClientCapability), + updateClientCapabilities :: Maybe ClientCapabilityList, updateClientMLSPublicKeys :: MLSPublicKeys } deriving stock (Eq, Show, Generic) @@ -800,7 +817,13 @@ instance ToSchema UpdateClient where (description ?~ "A new name for this client.") schema ) - <*> updateClientCapabilities .= maybe_ capabilitiesFieldSchema + <*> updateClientCapabilities + .= maybe_ + ( optFieldWithDocModifier + "capabilities" + (description ?~ "Hints provided by the client for the backend so it can behave in a backwards-compatible way.") + schema + ) <*> updateClientMLSPublicKeys .= mlsPublicKeysFieldSchema -------------------------------------------------------------------------------- diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/NewClient_user.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/NewClient_user.hs index 17b3893bef6..98bb2187a95 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/NewClient_user.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/NewClient_user.hs @@ -66,7 +66,7 @@ testObject_NewClient_user_2 = "I\1065423\995547oIC\by\1045956\&1\13659&w>S~z\35967\a{2Dj\v|Z\"\f\1060612*[\65357V\1086491kS\145031A\1106044\1056321(2\DLE\48205\SOi\SI(\1032525\168748f?q\SO5\146557d\1068952^nI\1103535_?\1019210H\119099\SUBf\995865\n\1004095x\ACKdZ\1053945^N\fa\SYN\SUBb=\1112183SP\128516aTd\EM\186127\DC3\ACK\ETB!\1011808\142127o{uoN\CANqL\NAK\ESCc=\v@o2\1043826\EOT\142486\US\1079334\&5v\STX\GS_k,\DC3mAV>$\1029013\1061276\RS\1089843\n\8980-\60552ea}G`r? \DEL\1004551\SOH\US\132757\&9\brl\155069}u\120967\1080794\1062392@M6M\155107\98552\167588|E5Ud\1051152tLjQ\1022837\6734\RS\v\DC1jE\ACK'~f\SIR\1010717\NAKd}}\1059960q\1031766\DC1\151174\&9\160469\RS\100592\ETX\186780\DEL\r\FS\US\36812\14285\NAK/\GS\25526\1090814\61061\NUL(:\1054313n#m9x \1078109\183480}\1052622\54486\GS\991929\b`\1087609G#T\DC2-8\NAK\18310\134655\tp/!\STX4C\SUB'DP'.\a\1110090\&8<9\SYN\NAKEq\168018Ep]\ajZ%\1025589\4170O\35069>\CAN\ACKw*f<\1102303\SOjzpjY\US\SUB\19086\DC1\DC1\ACK|\SO\1064500;\135633F!f\19971b%\1048714t9\DC2\f\121106X! \133247C\RS\1029038\162320C!\20923H(/\GSV)e\SYN2\NUL#H$BAJy\ETB\162654X\137014\FS\SUB\DEL~\f\ESC;\n<\GSf~{\b_" ), newClientModel = Just "om", - newClientCapabilities = Just (Set.fromList [ClientSupportsLegalholdImplicitConsent]), + newClientCapabilities = Just (ClientCapabilityList (Set.fromList [ClientSupportsLegalholdImplicitConsent])), newClientMLSPublicKeys = mempty, newClientVerificationCode = Nothing } diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/UpdateClient_user.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/UpdateClient_user.hs index be89952db7d..2fd40a5ac05 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/UpdateClient_user.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/UpdateClient_user.hs @@ -287,6 +287,6 @@ testObject_UpdateClient_user_20 = ], updateClientLastKey = Just (lastPrekey "\DC4 }Kg\ve3"), updateClientLabel = Just "\ESC\EOT\SOHccn\US{Y5", - updateClientCapabilities = Just [ClientSupportsLegalholdImplicitConsent], + updateClientCapabilities = Just (ClientCapabilityList [ClientSupportsLegalholdImplicitConsent]), updateClientMLSPublicKeys = mempty } diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual.hs index d85fdd1bbd8..2d5c43f18fb 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual.hs @@ -106,12 +106,21 @@ tests = ], testGroup "ClientCapability" $ testObjects - [(testObject_ClientCapability_1, "testObject_ClientCapability_1.json")], - testGroup "ClientCapabilityList" $ + [ (testObject_ClientCapability_1, "testObject_ClientCapability_1.json"), + (testObject_ClientCapability_2, "testObject_ClientCapability_2.json") + ], + testGroup "ClientCapabilityListV6" $ testObjects [ (testObject_ClientCapabilityList_1, "testObject_ClientCapabilityList_1.json"), (testObject_ClientCapabilityList_2, "testObject_ClientCapabilityList_2.json") ], + testGroup "ClientCapabilityListV6 - non-round-trip" $ + [testToJSON testObject_ClientCapabilityList_3 "testObject_ClientCapabilityList_3.json"], + testGroup "ClientCapabilityList" $ + testObjects + [ (testObject_ClientCapabilityList_4, "testObject_ClientCapabilityList_4.json"), + (testObject_ClientCapabilityList_5, "testObject_ClientCapabilityList_5.json") + ], testGroup "Event.FeatureConfig.Event" $ testObjects diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/ClientCapabilityList.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/ClientCapabilityList.hs index 477e4bbcadf..bbb616c990a 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/ClientCapabilityList.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/ClientCapabilityList.hs @@ -19,10 +19,35 @@ module Test.Wire.API.Golden.Manual.ClientCapabilityList where import Data.Set qualified as Set import Imports +import Wire.API.Routes.Version +import Wire.API.Routes.Versioned import Wire.API.User.Client (ClientCapability (..), ClientCapabilityList (..)) -testObject_ClientCapabilityList_1 :: ClientCapabilityList -testObject_ClientCapabilityList_1 = ClientCapabilityList mempty +testObject_ClientCapabilityList_1 :: Versioned V6 ClientCapabilityList +testObject_ClientCapabilityList_1 = Versioned $ ClientCapabilityList mempty -testObject_ClientCapabilityList_2 :: ClientCapabilityList -testObject_ClientCapabilityList_2 = ClientCapabilityList (Set.fromList [ClientSupportsLegalholdImplicitConsent]) +testObject_ClientCapabilityList_2 :: Versioned V6 ClientCapabilityList +testObject_ClientCapabilityList_2 = Versioned $ ClientCapabilityList (Set.fromList [ClientSupportsLegalholdImplicitConsent]) + +testObject_ClientCapabilityList_3 :: Versioned V6 ClientCapabilityList +testObject_ClientCapabilityList_3 = + Versioned $ + ClientCapabilityList + ( Set.fromList + [ ClientSupportsLegalholdImplicitConsent, + ClientSupportsConsumableNotifications + ] + ) + +testObject_ClientCapabilityList_4 :: ClientCapabilityList +testObject_ClientCapabilityList_4 = + ClientCapabilityList mempty + +testObject_ClientCapabilityList_5 :: ClientCapabilityList +testObject_ClientCapabilityList_5 = + ClientCapabilityList + ( Set.fromList + [ ClientSupportsLegalholdImplicitConsent, + ClientSupportsConsumableNotifications + ] + ) diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Runner.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Runner.hs index a7db1f7594d..d428e941c32 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Runner.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Runner.hs @@ -17,6 +17,7 @@ module Test.Wire.API.Golden.Runner ( testObjects, + testToJSON, protoTestObjects, testFromJSONFailure, testFromJSONFailureWithMsg, @@ -46,8 +47,19 @@ testObjects = fmap (\(obj, path) -> testCase path $ testObject obj path) testObject :: forall a. (Typeable a, ToJSON a, FromJSON a, Eq a, Show a) => a -> FilePath -> Assertion testObject obj path = do + assertJSONIsGolden obj path + assertEqual + (show (typeRep @a) <> ": FromJSON of " <> path <> " should match object") + (Success obj) + (fromJSON $ toJSON obj) + +testToJSON :: forall a. (Typeable a, ToJSON a) => a -> FilePath -> TestTree +testToJSON obj path = testCase path $ assertJSONIsGolden obj path + +assertJSONIsGolden :: forall a. (Typeable a, ToJSON a) => a -> FilePath -> Assertion +assertJSONIsGolden obj path = do let actualValue = toJSON obj :: Value - actualJson = encodePretty' config actualValue + actualJson = encodePretty' encodeConfig actualValue dir = "test/golden" fullPath = dir <> "/" <> path createDirectoryIfMissing True dir @@ -60,20 +72,17 @@ testObject obj path = do <> ": ToJSON should match golden file: " <> path <> "\n\nexpected:\n" - <> cs (encodePretty' config expectedValue) + <> cs (encodePretty' encodeConfig expectedValue) <> "\n\nactual:\n" - <> cs (encodePretty' config actualValue) + <> cs (encodePretty' encodeConfig actualValue) <> "\n\ndiff:\n" - <> cs (encodePretty' config (AD.diff expectedValue actualValue)) + <> cs (encodePretty' encodeConfig (AD.diff expectedValue actualValue)) ) (expectedValue == actualValue) - assertEqual - (show (typeRep @a) <> ": FromJSON of " <> path <> " should match object") - (Success obj) - (fromJSON actualValue) assertBool ("JSON golden file " <> path <> " does not exist") exists - where - config = defConfig {confCompare = compare, confTrailingNewline = True} + +encodeConfig :: Config +encodeConfig = defConfig {confCompare = compare, confTrailingNewline = True} protoTestObjects :: forall m a. diff --git a/libs/wire-api/test/golden/testObject_ClientCapabilityList_3.json b/libs/wire-api/test/golden/testObject_ClientCapabilityList_3.json new file mode 100644 index 00000000000..89c37fb330c --- /dev/null +++ b/libs/wire-api/test/golden/testObject_ClientCapabilityList_3.json @@ -0,0 +1,5 @@ +{ + "capabilities": [ + "legalhold-implicit-consent" + ] +} diff --git a/libs/wire-api/test/golden/testObject_ClientCapabilityList_4.json b/libs/wire-api/test/golden/testObject_ClientCapabilityList_4.json new file mode 100644 index 00000000000..fe51488c706 --- /dev/null +++ b/libs/wire-api/test/golden/testObject_ClientCapabilityList_4.json @@ -0,0 +1 @@ +[] diff --git a/libs/wire-api/test/golden/testObject_ClientCapabilityList_5.json b/libs/wire-api/test/golden/testObject_ClientCapabilityList_5.json new file mode 100644 index 00000000000..e7711560546 --- /dev/null +++ b/libs/wire-api/test/golden/testObject_ClientCapabilityList_5.json @@ -0,0 +1,4 @@ +[ + "legalhold-implicit-consent", + "consumable-notifications" +]