diff --git a/changelog.d/3-bug-fixes/wpb-6400-client-caps-aeson-schema b/changelog.d/3-bug-fixes/wpb-6400-client-caps-aeson-schema new file mode 100644 index 00000000000..a31e4a18402 --- /dev/null +++ b/changelog.d/3-bug-fixes/wpb-6400-client-caps-aeson-schema @@ -0,0 +1 @@ +Fix: (de-)serialization of client capabilities diff --git a/libs/brig-types/src/Brig/Types/User/Event.hs b/libs/brig-types/src/Brig/Types/User/Event.hs index 19bfc56315e..c0870e3c080 100644 --- a/libs/brig-types/src/Brig/Types/User/Event.hs +++ b/libs/brig-types/src/Brig/Types/User/Event.hs @@ -68,7 +68,7 @@ data PropertyEvent | PropertiesCleared !UserId data ClientEvent - = ClientAdded !UserId !Client + = ClientAdded !UserId !Client' | ClientRemoved !UserId !ClientId data UserUpdatedData = UserUpdatedData 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 4a52bf64aa7..6a11a47e55a 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs @@ -450,7 +450,7 @@ type AccountAPI = ( "clients" :> "full" :> ReqBody '[Servant.JSON] UserSet - :> Post '[Servant.JSON] UserClientsFull + :> Post '[Servant.JSON] (UserClientsFull ClientV5 {- for smooth upgrades around #3873; see 'addClientInternalH' for details -}) ) :<|> Named "iAddClient" @@ -463,7 +463,7 @@ type AccountAPI = :> QueryParam' [Optional, Strict] "skip_reauth" Bool :> ReqBody '[Servant.JSON] NewClient :> Header' [Optional, Strict] "Z-Connection" ConnId - :> Verb 'POST 201 '[Servant.JSON] Client + :> Verb 'POST 201 '[Servant.JSON] (ClientV5 {- for smooth upgrades around #3873; see 'addClientInternalH' for details -}) ) :<|> Named "iLegalholdAddClient" diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index ada615249cb..660b1cdea46 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -126,7 +126,7 @@ type QualifiedCaptureUserId name = QualifiedCapture' '[Description "User Id"] na type CaptureClientId name = Capture' '[Description "ClientId"] name ClientId -type NewClientResponse = Headers '[Header "Location" ClientId] Client +type NewClientResponse client = Headers '[Header "Location" ClientId] client type DeleteSelfResponses = '[ RespondEmpty 200 "Deletion is initiated.", @@ -726,8 +726,9 @@ type UserClientAPI = -- - ClientAdded event to self -- - ClientRemoved event to self, if removing old clients due to max number Named - "add-client" + "add-client-v6" ( Summary "Register a new client" + :> Until 'V6 :> CanThrow 'TooManyClients :> CanThrow 'MissingAuth :> CanThrow 'MalformedPrekeys @@ -737,8 +738,23 @@ type UserClientAPI = :> ZConn :> "clients" :> ReqBody '[JSON] NewClient - :> Verb 'POST 201 '[JSON] NewClientResponse + :> Verb 'POST 201 '[JSON] (NewClientResponse ClientV5) ) + :<|> Named + "add-client@v6" + ( Summary "Register a new client" + :> From 'V6 + :> CanThrow 'TooManyClients + :> CanThrow 'MissingAuth + :> CanThrow 'MalformedPrekeys + :> CanThrow 'CodeAuthenticationFailed + :> CanThrow 'CodeAuthenticationRequired + :> ZUser + :> ZConn + :> "clients" + :> ReqBody '[JSON] NewClient + :> Verb 'POST 201 '[JSON] (NewClientResponse Client') + ) :<|> Named "update-client" ( Summary "Update a registered client" @@ -763,15 +779,38 @@ type UserClientAPI = :> MultiVerb 'DELETE '[JSON] '[RespondEmpty 200 "Client deleted"] () ) :<|> Named - "list-clients" + "list-clients-v6" + ( Summary "List the registered clients" + :> ZUser + :> "clients" + :> Get '[JSON] [ClientV5] + ) + :<|> Named + "list-clients@v6" ( Summary "List the registered clients" :> ZUser :> "clients" - :> Get '[JSON] [Client] + :> Get '[JSON] [Client'] + ) + :<|> Named + "get-client-v6" + ( Summary "Get a registered client by ID" + :> Until 'V6 + :> ZUser + :> "clients" + :> CaptureClientId "client" + :> MultiVerb + 'GET + '[JSON] + '[ EmptyErrorForLegacyReasons 404 "Client not found", + Respond 200 "Client found" ClientV5 + ] + (Maybe ClientV5) ) :<|> Named - "get-client" + "get-client@v6" ( Summary "Get a registered client by ID" + :> From 'V6 :> ZUser :> "clients" :> CaptureClientId "client" @@ -779,9 +818,9 @@ type UserClientAPI = 'GET '[JSON] '[ EmptyErrorForLegacyReasons 404 "Client not found", - Respond 200 "Client found" Client + Respond 200 "Client found" Client' ] - (Maybe Client) + (Maybe Client') ) :<|> Named "get-client-capabilities" diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig/Bot.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig/Bot.hs index 4d544b64a53..cc149d4e2ab 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig/Bot.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig/Bot.hs @@ -30,6 +30,7 @@ import Wire.API.Provider.Bot (BotUserView) import Wire.API.Routes.MultiVerb import Wire.API.Routes.Named (Named) import Wire.API.Routes.Public +import Wire.API.Routes.Version import Wire.API.User import Wire.API.User.Client import Wire.API.User.Client.Prekey (PrekeyId) @@ -39,9 +40,9 @@ type DeleteResponses = Respond 200 "User found" RemoveBotResponse ] -type GetClientResponses = +type GetClientResponses client = '[ ErrorResponse 'ClientNotFound, - Respond 200 "Client found" Client + Respond 200 "Client found" client ] type BotAPI = @@ -117,14 +118,26 @@ type BotAPI = :> MultiVerb1 'POST '[JSON] (RespondEmpty 200 "") ) :<|> Named - "bot-get-client" + "bot-get-client-v6" ( Summary "Get client for bot" + :> Until 'V6 :> CanThrow 'AccessDenied :> CanThrow 'ClientNotFound :> ZBot :> "bot" :> "client" - :> MultiVerb 'GET '[JSON] GetClientResponses (Maybe Client) + :> MultiVerb 'GET '[JSON] (GetClientResponses ClientV5) (Maybe ClientV5) + ) + :<|> Named + "bot-get-client@v6" + ( Summary "Get client for bot" + :> From 'V6 + :> CanThrow 'AccessDenied + :> CanThrow 'ClientNotFound + :> ZBot + :> "bot" + :> "client" + :> MultiVerb 'GET '[JSON] (GetClientResponses Client') (Maybe Client') ) :<|> Named "bot-claim-users-prekeys" diff --git a/libs/wire-api/src/Wire/API/User/Client.hs b/libs/wire-api/src/Wire/API/User/Client.hs index d900d8b830a..b4ac466c0c2 100644 --- a/libs/wire-api/src/Wire/API/User/Client.hs +++ b/libs/wire-api/src/Wire/API/User/Client.hs @@ -45,7 +45,8 @@ module Wire.API.User.Client filterClientsFull, -- * Client - Client (..), + Client' (..), + ClientV5 (..), PubClient (..), ClientType (..), ClientClass (..), @@ -74,6 +75,7 @@ import Data.Aeson (FromJSON (..), ToJSON (..)) import Data.Aeson qualified as A import Data.Aeson.Key qualified as Key import Data.Aeson.KeyMap qualified as KeyMap +import Data.Aeson.Types qualified as A import Data.Bifunctor (second) import Data.Code qualified as Code import Data.Coerce @@ -84,6 +86,7 @@ import Data.Map.Strict qualified as Map import Data.Misc (Latitude (..), Longitude (..), PlainTextPassword6) import Data.OpenApi hiding (Schema, ToSchema, nullable, schema) import Data.OpenApi qualified as Swagger hiding (nullable) +import Data.Proxy import Data.Qualified import Data.Schema import Data.Set qualified as Set @@ -161,7 +164,6 @@ instance Cql.Cql ClientCapability where n -> Left $ "Unexpected ClientCapability value: " ++ show n fromCql _ = Left "ClientCapability value: int expected" --- FUTUREWORK: add golden tests for this? newtype ClientCapabilityList = ClientCapabilityList {fromClientCapabilityList :: Set ClientCapability} deriving stock (Eq, Ord, Show, Generic) deriving newtype (Semigroup, Monoid) @@ -353,16 +355,19 @@ instance ToSchema ClientInfo where -------------------------------------------------------------------------------- -- UserClients -newtype UserClientsFull = UserClientsFull - { userClientsFull :: Map UserId (Set Client) +newtype UserClientsFull client = UserClientsFull + { userClientsFull :: Map UserId (Set client) } deriving stock (Eq, Show, Generic) deriving newtype (Semigroup, Monoid) +instance Swagger.ToSchema (UserClientsFull ClientV5) where + declareNamedSchema _ = declareNamedSchema (Proxy @(UserClientsFull Client')) + -- | Json rendering of `UserClientsFull` is dynamic in the object fields, so it's unclear how -- machine-generated swagger would look like. We just leave the manual aeson instances in -- place and write something in English into the docs here. -instance Swagger.ToSchema UserClientsFull where +instance Swagger.ToSchema (UserClientsFull Client') where declareNamedSchema _ = do pure $ NamedSchema (Just "UserClientsFull") $ @@ -371,7 +376,7 @@ instance Swagger.ToSchema UserClientsFull where & description ?~ "Dictionary object of `Client` objects indexed by `UserId`." & example ?~ "{\"1355c55a-0ac8-11ee-97ee-db1a6351f093\": , ...}" -instance ToJSON UserClientsFull where +instance (Ord client, ToJSON client) => ToJSON (UserClientsFull client) where toJSON = toJSON . Map.foldrWithKey' fn Map.empty . userClientsFull where @@ -379,16 +384,16 @@ instance ToJSON UserClientsFull where let k = Text.E.decodeLatin1 (toASCIIBytes (toUUID u)) in Map.insert k c m -instance FromJSON UserClientsFull where +instance (Ord client, FromJSON client) => FromJSON (UserClientsFull client) where parseJSON = A.withObject "UserClientsFull" (fmap UserClientsFull . foldrM fn Map.empty . KeyMap.toList) where fn (k, v) m = Map.insert <$> parseJSON (A.String $ Key.toText k) <*> parseJSON v <*> pure m -instance Arbitrary UserClientsFull where +instance (Ord client, Arbitrary client) => Arbitrary (UserClientsFull client) where arbitrary = UserClientsFull <$> mapOf' arbitrary (setOf' arbitrary) -userClientsFullToUserClients :: UserClientsFull -> UserClients +userClientsFullToUserClients :: UserClientsFull Client' -> UserClients userClientsFullToUserClients (UserClientsFull mp) = UserClients $ Set.map clientId <$> mp newtype UserClients = UserClients @@ -422,7 +427,7 @@ instance Arbitrary UserClients where filterClients :: (Set ClientId -> Bool) -> UserClients -> UserClients filterClients p (UserClients c) = UserClients $ Map.filter p c -filterClientsFull :: (Set Client -> Bool) -> UserClientsFull -> UserClientsFull +filterClientsFull :: (Set Client' -> Bool) -> UserClientsFull Client' -> UserClientsFull Client' filterClientsFull p (UserClientsFull c) = UserClientsFull $ Map.filter p c newtype QualifiedUserClients = QualifiedUserClients @@ -462,7 +467,7 @@ instance ToSchema QualifiedUserClients where -------------------------------------------------------------------------------- -- Client -data Client = Client +data Client' = Client { clientId :: ClientId, clientType :: ClientType, clientTime :: UTCTimeMillis, @@ -475,8 +480,70 @@ data Client = Client clientLastActive :: Maybe UTCTime } deriving stock (Eq, Show, Generic, Ord) - deriving (Arbitrary) via (GenericUniform Client) - deriving (FromJSON, ToJSON, Swagger.ToSchema) via Schema Client + deriving (Arbitrary) via (GenericUniform Client') + deriving (ToJSON, Swagger.ToSchema) via Schema Client' + +instance ToSchema Client' where + schema = + object "Client" $ + Client + <$> clientId .= field "id" schema + <*> clientType .= field "type" schema + <*> clientTime .= field "time" schema + <*> clientClass .= maybe_ (optField "class" schema) + <*> clientLabel .= maybe_ (optField "label" schema) + <*> clientCookie .= maybe_ (optField "cookie" schema) + <*> clientModel .= maybe_ (optField "model" schema) + <*> (Just . fromClientCapabilityList . clientCapabilities) .= maybe_ (ClientCapabilityList . fromMaybe Set.empty <$> capabilitiesFieldSchema) + <*> clientMLSPublicKeys .= mlsPublicKeysFieldSchema + <*> clientLastActive .= maybe_ (optField "last_active" utcTimeSchema) + +-- | For the time we grant users to upgrade accross #3873, this lenient parser parses both +-- Client and ClientV5 as Client. Once everybody has upgraded, we can go back to deriving +-- this and failing on ClientV5 input. (See 'addClientInternalH' for details.) +instance FromJSON Client' where + parseJSON = A.withObject "Client" $ \obj -> do + Client + <$> obj A..: "id" + <*> obj A..: "type" + <*> obj A..: "time" + <*> obj A..:? "class" + <*> obj A..:? "label" + <*> obj A..:? "cookie" + <*> obj A..:? "model" + <*> (maybe (pure $ ClientCapabilityList Set.empty) parseCaps =<< obj A..:? "capabilities") + <*> _ -- (fromMaybe mempty <$> obj A..:? "mls_public_keys") + <*> obj A..:? "last_active" + where + -- TODO: it should be possible to base implementations for all 3 `_` on existing + -- `ToSchema` instances of Client', ClientV5. but how? + + parseCaps :: A.Value -> A.Parser ClientCapabilityList + parseCaps val = prs val <|> prsLegacy val + where + prs = _ + prsLegacy = _ + +newtype ClientV5 = ClientV5 {fromClientV5 :: Client'} + deriving newtype (Eq, Show, Generic, Ord, Arbitrary) + deriving (FromJSON, ToJSON, Swagger.ToSchema) via Schema ClientV5 + +instance ToSchema ClientV5 where + schema = + ClientV5 + <$> ( object "Client" $ + Client + <$> (clientId . fromClientV5) .= field "id" schema + <*> (clientType . fromClientV5) .= field "type" schema + <*> (clientTime . fromClientV5) .= field "time" schema + <*> (clientClass . fromClientV5) .= maybe_ (optField "class" schema) + <*> (clientLabel . fromClientV5) .= maybe_ (optField "label" schema) + <*> (clientCookie . fromClientV5) .= maybe_ (optField "cookie" schema) + <*> (clientModel . fromClientV5) .= maybe_ (optField "model" schema) + <*> (clientCapabilities . fromClientV5) .= (fromMaybe mempty <$> optField "capabilities" schema) + <*> (clientMLSPublicKeys . fromClientV5) .= mlsPublicKeysFieldSchema + <*> (clientLastActive . fromClientV5) .= maybe_ (optField "last_active" utcTimeSchema) + ) type MLSPublicKeys = Map SignatureSchemeTag ByteString @@ -498,21 +565,6 @@ mlsPublicKeysSchema = mapSchema :: ValueSchema SwaggerDoc MLSPublicKeys mapSchema = map_ base64Schema -instance ToSchema Client where - schema = - object "Client" $ - Client - <$> clientId .= field "id" schema - <*> clientType .= field "type" schema - <*> clientTime .= field "time" schema - <*> clientClass .= maybe_ (optField "class" schema) - <*> clientLabel .= maybe_ (optField "label" schema) - <*> clientCookie .= maybe_ (optField "cookie" schema) - <*> clientModel .= maybe_ (optField "model" schema) - <*> clientCapabilities .= (fromMaybe mempty <$> optField "capabilities" schema) - <*> clientMLSPublicKeys .= mlsPublicKeysFieldSchema - <*> clientLastActive .= maybe_ (optField "last_active" utcTimeSchema) - mlsPublicKeysFieldSchema :: ObjectSchema SwaggerDoc MLSPublicKeys mlsPublicKeysFieldSchema = fromMaybe mempty <$> optField "mls_public_keys" mlsPublicKeysSchema diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Client_user.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Client_user.hs index ad281de21d3..791b6ad4b24 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Client_user.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Client_user.hs @@ -28,7 +28,7 @@ import Wire.API.MLS.CipherSuite import Wire.API.User.Auth (CookieLabel (CookieLabel, cookieLabelText)) import Wire.API.User.Client -testObject_Client_user_1 :: Client +testObject_Client_user_1 :: Client' testObject_Client_user_1 = Client { clientId = ClientId 2, @@ -43,7 +43,7 @@ testObject_Client_user_1 = clientLastActive = Nothing } -testObject_Client_user_2 :: Client +testObject_Client_user_2 :: Client' testObject_Client_user_2 = Client { clientId = ClientId 1, @@ -58,7 +58,7 @@ testObject_Client_user_2 = clientLastActive = Nothing } -testObject_Client_user_3 :: Client +testObject_Client_user_3 :: Client' testObject_Client_user_3 = Client { clientId = ClientId 1, @@ -73,7 +73,7 @@ testObject_Client_user_3 = clientLastActive = fmap fromUTCTimeMillis (readUTCTimeMillis "2023-07-04T09:35:32.000Z") } -testObject_Client_user_4 :: Client +testObject_Client_user_4 :: Client' testObject_Client_user_4 = Client { clientId = ClientId 3, @@ -88,7 +88,7 @@ testObject_Client_user_4 = clientLastActive = Nothing } -testObject_Client_user_5 :: Client +testObject_Client_user_5 :: Client' testObject_Client_user_5 = Client { clientId = ClientId 0, @@ -103,7 +103,7 @@ testObject_Client_user_5 = clientLastActive = Nothing } -testObject_Client_user_6 :: Client +testObject_Client_user_6 :: Client' testObject_Client_user_6 = Client { clientId = ClientId 4, @@ -118,7 +118,7 @@ testObject_Client_user_6 = clientLastActive = fmap fromUTCTimeMillis (readUTCTimeMillis "2021-09-15T22:00:21.000Z") } -testObject_Client_user_7 :: Client +testObject_Client_user_7 :: Client' testObject_Client_user_7 = Client { clientId = ClientId 4, @@ -133,7 +133,7 @@ testObject_Client_user_7 = clientLastActive = Nothing } -testObject_Client_user_8 :: Client +testObject_Client_user_8 :: Client' testObject_Client_user_8 = Client { clientId = ClientId 4, @@ -148,7 +148,7 @@ testObject_Client_user_8 = clientLastActive = Nothing } -testObject_Client_user_9 :: Client +testObject_Client_user_9 :: Client' testObject_Client_user_9 = Client { clientId = ClientId 1, @@ -163,7 +163,7 @@ testObject_Client_user_9 = clientLastActive = Nothing } -testObject_Client_user_10 :: Client +testObject_Client_user_10 :: Client' testObject_Client_user_10 = Client { clientId = ClientId 0, @@ -178,7 +178,7 @@ testObject_Client_user_10 = clientLastActive = Nothing } -testObject_Client_user_11 :: Client +testObject_Client_user_11 :: Client' testObject_Client_user_11 = Client { clientId = ClientId 3, @@ -193,7 +193,7 @@ testObject_Client_user_11 = clientLastActive = Nothing } -testObject_Client_user_12 :: Client +testObject_Client_user_12 :: Client' testObject_Client_user_12 = Client { clientId = ClientId 2, @@ -208,7 +208,7 @@ testObject_Client_user_12 = clientLastActive = Nothing } -testObject_Client_user_13 :: Client +testObject_Client_user_13 :: Client' testObject_Client_user_13 = Client { clientId = ClientId 2, @@ -223,7 +223,7 @@ testObject_Client_user_13 = clientLastActive = Nothing } -testObject_Client_user_14 :: Client +testObject_Client_user_14 :: Client' testObject_Client_user_14 = Client { clientId = ClientId 2, @@ -238,7 +238,7 @@ testObject_Client_user_14 = clientLastActive = Nothing } -testObject_Client_user_15 :: Client +testObject_Client_user_15 :: Client' testObject_Client_user_15 = Client { clientId = ClientId 3, @@ -253,7 +253,7 @@ testObject_Client_user_15 = clientLastActive = Nothing } -testObject_Client_user_16 :: Client +testObject_Client_user_16 :: Client' testObject_Client_user_16 = Client { clientId = ClientId 2, @@ -268,7 +268,7 @@ testObject_Client_user_16 = clientLastActive = Nothing } -testObject_Client_user_17 :: Client +testObject_Client_user_17 :: Client' testObject_Client_user_17 = Client { clientId = ClientId 4, @@ -283,7 +283,7 @@ testObject_Client_user_17 = clientLastActive = Nothing } -testObject_Client_user_18 :: Client +testObject_Client_user_18 :: Client' testObject_Client_user_18 = Client { clientId = ClientId 1, @@ -298,7 +298,7 @@ testObject_Client_user_18 = clientLastActive = Nothing } -testObject_Client_user_19 :: Client +testObject_Client_user_19 :: Client' testObject_Client_user_19 = Client { clientId = ClientId 2, @@ -313,7 +313,7 @@ testObject_Client_user_19 = clientLastActive = Nothing } -testObject_Client_user_20 :: Client +testObject_Client_user_20 :: Client' testObject_Client_user_20 = Client { clientId = ClientId 1, diff --git a/libs/wire-api/test/golden/testObject_Client_user_1.json b/libs/wire-api/test/golden/testObject_Client_user_1.json index 9fc8b644e4a..3ae58f75402 100644 --- a/libs/wire-api/test/golden/testObject_Client_user_1.json +++ b/libs/wire-api/test/golden/testObject_Client_user_1.json @@ -1,7 +1,5 @@ { - "capabilities": { - "capabilities": [] - }, + "capabilities": [], "class": "desktop", "id": "2", "label": "%*", diff --git a/libs/wire-api/test/golden/testObject_Client_user_10.json b/libs/wire-api/test/golden/testObject_Client_user_10.json index 1d08a33cfd0..35ad363f074 100644 --- a/libs/wire-api/test/golden/testObject_Client_user_10.json +++ b/libs/wire-api/test/golden/testObject_Client_user_10.json @@ -1,7 +1,5 @@ { - "capabilities": { - "capabilities": [] - }, + "capabilities": [], "cookie": "L", "id": "0", "mls_public_keys": { diff --git a/libs/wire-api/test/golden/testObject_Client_user_11.json b/libs/wire-api/test/golden/testObject_Client_user_11.json index 6e4c38b8dc9..8d6af47dc49 100644 --- a/libs/wire-api/test/golden/testObject_Client_user_11.json +++ b/libs/wire-api/test/golden/testObject_Client_user_11.json @@ -1,7 +1,5 @@ { - "capabilities": { - "capabilities": [] - }, + "capabilities": [], "class": "legalhold", "cookie": "5", "id": "3", diff --git a/libs/wire-api/test/golden/testObject_Client_user_12.json b/libs/wire-api/test/golden/testObject_Client_user_12.json index 644db85ecbf..63ca4553dee 100644 --- a/libs/wire-api/test/golden/testObject_Client_user_12.json +++ b/libs/wire-api/test/golden/testObject_Client_user_12.json @@ -1,7 +1,5 @@ { - "capabilities": { - "capabilities": [] - }, + "capabilities": [], "cookie": "0", "id": "2", "label": "", diff --git a/libs/wire-api/test/golden/testObject_Client_user_13.json b/libs/wire-api/test/golden/testObject_Client_user_13.json index 9034bcbc4ab..9b2552d9086 100644 --- a/libs/wire-api/test/golden/testObject_Client_user_13.json +++ b/libs/wire-api/test/golden/testObject_Client_user_13.json @@ -1,7 +1,5 @@ { - "capabilities": { - "capabilities": [] - }, + "capabilities": [], "class": "phone", "cookie": "\u000c^󷋏", "id": "2", diff --git a/libs/wire-api/test/golden/testObject_Client_user_14.json b/libs/wire-api/test/golden/testObject_Client_user_14.json index a4d61fe168c..c95b927805a 100644 --- a/libs/wire-api/test/golden/testObject_Client_user_14.json +++ b/libs/wire-api/test/golden/testObject_Client_user_14.json @@ -1,7 +1,5 @@ { - "capabilities": { - "capabilities": [] - }, + "capabilities": [], "class": "tablet", "id": "2", "label": "x\u000e", diff --git a/libs/wire-api/test/golden/testObject_Client_user_15.json b/libs/wire-api/test/golden/testObject_Client_user_15.json index 626f76201cd..7050d356278 100644 --- a/libs/wire-api/test/golden/testObject_Client_user_15.json +++ b/libs/wire-api/test/golden/testObject_Client_user_15.json @@ -1,7 +1,5 @@ { - "capabilities": { - "capabilities": [] - }, + "capabilities": [], "cookie": "􌨷N", "id": "3", "label": "\u0004G", diff --git a/libs/wire-api/test/golden/testObject_Client_user_16.json b/libs/wire-api/test/golden/testObject_Client_user_16.json index 7216da58868..e70257998b5 100644 --- a/libs/wire-api/test/golden/testObject_Client_user_16.json +++ b/libs/wire-api/test/golden/testObject_Client_user_16.json @@ -1,7 +1,5 @@ { - "capabilities": { - "capabilities": [] - }, + "capabilities": [], "class": "legalhold", "cookie": "U", "id": "2", diff --git a/libs/wire-api/test/golden/testObject_Client_user_17.json b/libs/wire-api/test/golden/testObject_Client_user_17.json index 9f0f36f96a3..485f822a3d2 100644 --- a/libs/wire-api/test/golden/testObject_Client_user_17.json +++ b/libs/wire-api/test/golden/testObject_Client_user_17.json @@ -1,7 +1,5 @@ { - "capabilities": { - "capabilities": [] - }, + "capabilities": [], "class": "desktop", "cookie": "", "id": "4", diff --git a/libs/wire-api/test/golden/testObject_Client_user_18.json b/libs/wire-api/test/golden/testObject_Client_user_18.json index 80dad343c4e..5f1ba1bf5b8 100644 --- a/libs/wire-api/test/golden/testObject_Client_user_18.json +++ b/libs/wire-api/test/golden/testObject_Client_user_18.json @@ -1,7 +1,5 @@ { - "capabilities": { - "capabilities": [] - }, + "capabilities": [], "class": "legalhold", "cookie": "PG:", "id": "1", diff --git a/libs/wire-api/test/golden/testObject_Client_user_19.json b/libs/wire-api/test/golden/testObject_Client_user_19.json index db061827756..f6263f00203 100644 --- a/libs/wire-api/test/golden/testObject_Client_user_19.json +++ b/libs/wire-api/test/golden/testObject_Client_user_19.json @@ -1,7 +1,5 @@ { - "capabilities": { - "capabilities": [] - }, + "capabilities": [], "class": "desktop", "id": "2", "label": "􌇰l", diff --git a/libs/wire-api/test/golden/testObject_Client_user_2.json b/libs/wire-api/test/golden/testObject_Client_user_2.json index 08dd2786531..802de9bd21f 100644 --- a/libs/wire-api/test/golden/testObject_Client_user_2.json +++ b/libs/wire-api/test/golden/testObject_Client_user_2.json @@ -1,7 +1,5 @@ { - "capabilities": { - "capabilities": [] - }, + "capabilities": [], "cookie": "􏬺c􄂩", "id": "1", "mls_public_keys": {}, diff --git a/libs/wire-api/test/golden/testObject_Client_user_20.json b/libs/wire-api/test/golden/testObject_Client_user_20.json index 253cd8c3952..c9f3ae4459b 100644 --- a/libs/wire-api/test/golden/testObject_Client_user_20.json +++ b/libs/wire-api/test/golden/testObject_Client_user_20.json @@ -1,9 +1,7 @@ { - "capabilities": { - "capabilities": [ - "legalhold-implicit-consent" - ] - }, + "capabilities": [ + "legalhold-implicit-consent" + ], "class": "phone", "cookie": "", "id": "1", diff --git a/libs/wire-api/test/golden/testObject_Client_user_3.json b/libs/wire-api/test/golden/testObject_Client_user_3.json index 8c5026d2cb7..b6cb51e0fbf 100644 --- a/libs/wire-api/test/golden/testObject_Client_user_3.json +++ b/libs/wire-api/test/golden/testObject_Client_user_3.json @@ -1,7 +1,5 @@ { - "capabilities": { - "capabilities": [] - }, + "capabilities": [], "class": "legalhold", "cookie": "", "id": "1", diff --git a/libs/wire-api/test/golden/testObject_Client_user_4.json b/libs/wire-api/test/golden/testObject_Client_user_4.json index 25e8c8860bd..4a8398a2e9b 100644 --- a/libs/wire-api/test/golden/testObject_Client_user_4.json +++ b/libs/wire-api/test/golden/testObject_Client_user_4.json @@ -1,7 +1,5 @@ { - "capabilities": { - "capabilities": [] - }, + "capabilities": [], "class": "legalhold", "cookie": "j", "id": "3", diff --git a/libs/wire-api/test/golden/testObject_Client_user_5.json b/libs/wire-api/test/golden/testObject_Client_user_5.json index 0af93523dc2..e1967bb1bcf 100644 --- a/libs/wire-api/test/golden/testObject_Client_user_5.json +++ b/libs/wire-api/test/golden/testObject_Client_user_5.json @@ -1,7 +1,5 @@ { - "capabilities": { - "capabilities": [] - }, + "capabilities": [], "class": "desktop", "cookie": "", "id": "0", diff --git a/libs/wire-api/test/golden/testObject_Client_user_6.json b/libs/wire-api/test/golden/testObject_Client_user_6.json index 90a2b0ea16e..929f3132496 100644 --- a/libs/wire-api/test/golden/testObject_Client_user_6.json +++ b/libs/wire-api/test/golden/testObject_Client_user_6.json @@ -1,7 +1,5 @@ { - "capabilities": { - "capabilities": [] - }, + "capabilities": [], "class": "tablet", "cookie": "l\u0002", "id": "4", diff --git a/libs/wire-api/test/golden/testObject_Client_user_7.json b/libs/wire-api/test/golden/testObject_Client_user_7.json index 41253b1fb0a..8ca4dc49b6a 100644 --- a/libs/wire-api/test/golden/testObject_Client_user_7.json +++ b/libs/wire-api/test/golden/testObject_Client_user_7.json @@ -1,7 +1,5 @@ { - "capabilities": { - "capabilities": [] - }, + "capabilities": [], "class": "phone", "id": "4", "label": "", diff --git a/libs/wire-api/test/golden/testObject_Client_user_8.json b/libs/wire-api/test/golden/testObject_Client_user_8.json index fafbbc7e6e5..35f568dd53c 100644 --- a/libs/wire-api/test/golden/testObject_Client_user_8.json +++ b/libs/wire-api/test/golden/testObject_Client_user_8.json @@ -1,7 +1,5 @@ { - "capabilities": { - "capabilities": [] - }, + "capabilities": [], "class": "phone", "cookie": "\u0015p`", "id": "4", diff --git a/libs/wire-api/test/golden/testObject_Client_user_9.json b/libs/wire-api/test/golden/testObject_Client_user_9.json index ed4e67747ca..cfda4f2768a 100644 --- a/libs/wire-api/test/golden/testObject_Client_user_9.json +++ b/libs/wire-api/test/golden/testObject_Client_user_9.json @@ -1,7 +1,5 @@ { - "capabilities": { - "capabilities": [] - }, + "capabilities": [], "class": "legalhold", "cookie": "G", "id": "1", 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 aefaa6cb8cd..6f2ab84c617 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 @@ -291,11 +291,13 @@ tests = testRoundTrip @User.Auth.AccessToken, testRoundTrip @(User.Client.UserClientMap Int), testRoundTrip @User.Client.UserClients, - testRoundTrip @User.Client.UserClientsFull, + testRoundTrip @(User.Client.UserClientsFull User.Client.ClientV5), + testRoundTrip @(User.Client.UserClientsFull User.Client.Client'), testRoundTrip @User.Client.ClientType, testRoundTrip @User.Client.ClientClass, testRoundTrip @User.Client.PubClient, - testRoundTrip @User.Client.Client, + testRoundTrip @User.Client.ClientV5, + testRoundTrip @User.Client.Client', testRoundTrip @User.Client.NewClient, testRoundTrip @User.Client.UpdateClient, testRoundTripWithSwagger @User.Client.ClientCapability, diff --git a/libs/wire-api/test/unit/Test/Wire/API/Swagger.hs b/libs/wire-api/test/unit/Test/Wire/API/Swagger.hs index bbb37e6e2a4..90bbaa9e318 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Swagger.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Swagger.hs @@ -33,17 +33,18 @@ import Wire.API.Wrapped qualified as Wrapped tests :: T.TestTree tests = - T.localOption (T.Timeout (60 * 1000000) "60s") . T.testGroup "JSON roundtrip tests" $ + T.localOption (T.Timeout (60 * 1000000) "60s") . T.testGroup "JSON/swagger roundtrip tests" $ [ testToJSON @User.UserProfile, testToJSON @User.User, testToJSON @User.SelfProfile, testToJSON @(User.LimitedQualifiedUserIdList 20), testToJSON @Handle.UserHandleInfo, - testToJSON @Client.Client, + testToJSON @Client.ClientV5, + testToJSON @Client.Client', testToJSON @Client.PubClient, - testToJSON @(UserMap.UserMap (Set Client.Client)), + testToJSON @(UserMap.UserMap (Set Client.Client')), testToJSON @(UserMap.UserMap (Set Client.PubClient)), - testToJSON @(UserMap.QualifiedUserMap (Set Client.Client)), + testToJSON @(UserMap.QualifiedUserMap (Set Client.Client')), testToJSON @Client.UserClientPrekeyMap, testToJSON @Client.UserClients, testToJSON @Prekey.Prekey, diff --git a/services/brig/src/Brig/API/Client.hs b/services/brig/src/Brig/API/Client.hs index 2e7c16c1bd7..c479f2a992d 100644 --- a/services/brig/src/Brig/API/Client.hs +++ b/services/brig/src/Brig/API/Client.hs @@ -109,10 +109,10 @@ import Wire.Sem.Concurrency import Wire.Sem.FromUTC (FromUTC (fromUTCTime)) import Wire.Sem.Now as Now -lookupLocalClient :: UserId -> ClientId -> (AppT r) (Maybe Client) +lookupLocalClient :: UserId -> ClientId -> (AppT r) (Maybe Client') lookupLocalClient uid = wrapClient . Data.lookupClient uid -lookupLocalClients :: UserId -> (AppT r) [Client] +lookupLocalClients :: UserId -> (AppT r) [Client'] lookupLocalClients = wrapClient . Data.lookupClients lookupPubClient :: Qualified UserId -> ClientId -> ExceptT ClientError (AppT r) (Maybe PubClient) @@ -157,7 +157,7 @@ addClient :: UserId -> Maybe ConnId -> NewClient -> - ExceptT ClientError (AppT r) Client + ExceptT ClientError (AppT r) Client' addClient = addClientWithReAuthPolicy Data.reAuthForNewClients -- nb. We must ensure that the set of clients known to brig is always @@ -169,7 +169,7 @@ addClientWithReAuthPolicy :: UserId -> Maybe ConnId -> NewClient -> - ExceptT ClientError (AppT r) Client + ExceptT ClientError (AppT r) Client' addClientWithReAuthPolicy policy u con new = do acc <- lift (wrapClient $ Data.lookupAccount u) >>= maybe (throwE (ClientUserNotFound u)) pure verifyCode (newClientVerificationCode new) (userId . accountUser $ acc) @@ -424,7 +424,7 @@ claimLocalMultiPrekeyBundles protectee userClients = do -- Utilities -- | Enqueue an orderly deletion of an existing client. -execDelete :: UserId -> Maybe ConnId -> Client -> (AppT r) () +execDelete :: UserId -> Maybe ConnId -> Client' -> (AppT r) () execDelete u con c = do for_ (clientCookie c) $ \l -> wrapClient $ Auth.revokeCookies u [] [l] queue <- view internalEvents @@ -455,7 +455,7 @@ noPrekeys u c = do ~~ msg (val "No prekey found. Deleting client.") execDelete u Nothing client -pubClient :: Client -> PubClient +pubClient :: Client' -> PubClient pubClient c = PubClient { pubClientId = clientId c, diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index 72e6eaeb8ff..c5e9037bdb7 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -347,18 +347,26 @@ sitemap = unsafeCallsFed @'Brig @"on-user-deleted-connections" $ do -- Handlers -- | Add a client without authentication checks +-- +-- This returns a 'ClientV5' instead of a 'Client' to avoid glitches during upgrades: brig +-- will keep delivering legacy values after the upgrade, and the 'Client' parser makes sure +-- that those legacy values can be understood by galley after the upgrade, so whether brig or +-- galley is upgraded first is important: both combinations of pre- and post-#3873 work! +-- +-- FUTUREWORK: change this back to 'Client' once everybody can be expected to have upgraded +-- past this change. addClientInternalH :: (Member GalleyProvider r) => UserId -> Maybe Bool -> NewClient -> Maybe ConnId -> - (Handler r) Client + (Handler r) ClientV5 addClientInternalH usr mSkipReAuth new connId = do let policy | mSkipReAuth == Just True = \_ _ -> False | otherwise = Data.reAuthForNewClients - API.addClientWithReAuthPolicy policy usr connId new !>> clientError + ClientV5 <$> API.addClientWithReAuthPolicy policy usr connId new !>> clientError legalHoldClientRequestedH :: UserId -> LegalHoldClientRequest -> (Handler r) NoContent legalHoldClientRequestedH targetUser clientRequest = do @@ -373,7 +381,9 @@ internalListClientsH (UserSet usrs) = lift $ do UserClients . Map.fromList <$> wrapClient (API.lookupUsersClientIds (Set.toList usrs)) -internalListFullClientsH :: UserSet -> (Handler r) UserClientsFull +-- | This returns a 'ClientV5' instead of a 'Client' to avoid glitches during upgrades (see +-- 'addClientInternalH' for details). +internalListFullClientsH :: UserSet -> (Handler r) UserClientsFull' internalListFullClientsH (UserSet usrs) = lift $ do UserClientsFull <$> wrapClient (Data.lookupClientsBulk (Set.toList usrs)) diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index d61beffefa4..9a35db4bb30 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -357,11 +357,14 @@ servantSitemap = userClientAPI :: ServerT UserClientAPI (Handler r) userClientAPI = - Named @"add-client" (callsFed (exposeAnnotations addClient)) + Named @"add-client-v6" (callsFed (exposeAnnotations addClientV5)) + :<|> Named @"add-client@v6" (callsFed (exposeAnnotations addClient)) :<|> Named @"update-client" updateClient :<|> Named @"delete-client" deleteClient - :<|> Named @"list-clients" listClients - :<|> Named @"get-client" getClient + :<|> Named @"list-clients-v6" listClientsV5 + :<|> Named @"list-clients@v6" listClients + :<|> Named @"get-client-v6" getClientV5 + :<|> Named @"get-client@v6" getClient :<|> Named @"get-client-capabilities" getClientCapabilities :<|> Named @"get-client-prekeys" getClientPrekeys :<|> Named @"head-nonce" newNonce @@ -554,12 +557,28 @@ getMultiUserPrekeyBundleH zusr qualUserClients = do getMultiUserPrekeyBundleHInternal qualUserClients API.claimMultiPrekeyBundles (ProtectedUser zusr) qualUserClients !>> clientError +addClientV5 :: + (Member GalleyProvider r) => + UserId -> + ConnId -> + Public.NewClient -> + (Handler r) (NewClientResponse Public.ClientV5) +addClientV5 usr con new = do + when (Public.newClientType new == Public.LegalHoldClientType) $ + throwE (clientError ClientLegalHoldCannotBeAdded) + clientResponse + <$> API.addClient usr (Just con) new + !>> clientError + where + clientResponse :: Public.Client' -> NewClientResponse Public.ClientV5 + clientResponse client = Servant.addHeader (Public.clientId client) (Public.ClientV5 client) + addClient :: (Member GalleyProvider r) => UserId -> ConnId -> Public.NewClient -> - (Handler r) NewClientResponse + (Handler r) (NewClientResponse Public.Client') addClient usr con new = do -- Users can't add legal hold clients when (Public.newClientType new == Public.LegalHoldClientType) $ @@ -568,7 +587,7 @@ addClient usr con new = do <$> API.addClient usr (Just con) new !>> clientError where - clientResponse :: Public.Client -> NewClientResponse + clientResponse :: Public.Client' -> NewClientResponse Public.Client' clientResponse client = Servant.addHeader (Public.clientId client) client deleteClient :: UserId -> ConnId -> ClientId -> Public.RmClient -> (Handler r) () @@ -578,11 +597,17 @@ deleteClient usr con clt body = updateClient :: UserId -> ClientId -> Public.UpdateClient -> (Handler r) () updateClient usr clt upd = wrapClientE (API.updateClient usr clt upd) !>> clientError -listClients :: UserId -> (Handler r) [Public.Client] +listClientsV5 :: UserId -> (Handler r) [Public.ClientV5] +listClientsV5 zusr = Public.ClientV5 <$$> listClients zusr + +listClients :: UserId -> (Handler r) [Public.Client'] listClients zusr = lift $ API.lookupLocalClients zusr -getClient :: UserId -> ClientId -> (Handler r) (Maybe Public.Client) +getClientV5 :: UserId -> ClientId -> (Handler r) (Maybe Public.ClientV5) +getClientV5 zusr clientId = Public.ClientV5 <$$> getClient zusr clientId + +getClient :: UserId -> ClientId -> (Handler r) (Maybe Public.Client') getClient zusr clientId = lift $ API.lookupLocalClient zusr clientId getUserClientsUnqualified :: UserId -> (Handler r) [Public.PubClient] diff --git a/services/brig/src/Brig/Data/Client.hs b/services/brig/src/Brig/Data/Client.hs index 9b864391503..d7261783744 100644 --- a/services/brig/src/Brig/Data/Client.hs +++ b/services/brig/src/Brig/Data/Client.hs @@ -124,7 +124,7 @@ addClient :: NewClient -> Int -> Maybe (Imports.Set ClientCapability) -> - ExceptT ClientDataError m (Client, [Client], Word) + ExceptT ClientDataError m (Client', [Client'], Word) addClient = addClientWithReAuthPolicy reAuthForNewClients addClientWithReAuthPolicy :: @@ -135,7 +135,7 @@ addClientWithReAuthPolicy :: NewClient -> Int -> Maybe (Imports.Set ClientCapability) -> - ExceptT ClientDataError m (Client, [Client], Word) + ExceptT ClientDataError m (Client', [Client'], Word) addClientWithReAuthPolicy reAuthPolicy u newId c maxPermClients cps = do clients <- lookupClients u let typed = filter ((== newClientType c) . clientType) clients @@ -158,10 +158,10 @@ addClientWithReAuthPolicy reAuthPolicy u newId c maxPermClients cps = do TemporaryClientType -> Nothing LegalHoldClientType -> Nothing - exists :: Client -> Bool + exists :: Client' -> Bool exists = (==) newId . clientId - insert :: (MonadClient m, MonadReader Brig.App.Env m) => ExceptT ClientDataError m Client + insert :: (MonadClient m, MonadReader Brig.App.Env m) => ExceptT ClientDataError m Client' insert = do -- Is it possible to do this somewhere else? Otherwise we could use `MonadClient` instead now <- toUTCTimeMillis <$> (liftIO =<< view currentTime) @@ -185,18 +185,18 @@ addClientWithReAuthPolicy reAuthPolicy u newId c maxPermClients cps = do clientLastActive = Nothing } -lookupClient :: MonadClient m => UserId -> ClientId -> m (Maybe Client) +lookupClient :: MonadClient m => UserId -> ClientId -> m (Maybe Client') lookupClient u c = do keys <- retry x1 (query selectMLSPublicKeys (params LocalQuorum (u, c))) fmap (toClient keys) <$> retry x1 (query1 selectClient (params LocalQuorum (u, c))) -lookupClientsBulk :: (MonadClient m) => [UserId] -> m (Map UserId (Imports.Set Client)) +lookupClientsBulk :: (MonadClient m) => [UserId] -> m (Map UserId (Imports.Set Client')) lookupClientsBulk uids = liftClient $ do userClientTuples <- pooledMapConcurrentlyN 50 getClientSetWithUser uids pure $ Map.fromList userClientTuples where - getClientSetWithUser :: MonadClient m => UserId -> m (UserId, Imports.Set Client) + getClientSetWithUser :: MonadClient m => UserId -> m (UserId, Imports.Set Client') getClientSetWithUser u = fmap ((u,) . Set.fromList) . lookupClients $ u lookupPubClientsBulk :: (MonadClient m) => [UserId] -> m (UserMap (Imports.Set PubClient)) @@ -210,7 +210,7 @@ lookupPubClientsBulk uids = liftClient $ do executeQuery :: MonadClient m => UserId -> m [(ClientId, Maybe ClientClass)] executeQuery u = retry x1 (query selectPubClients (params LocalQuorum (Identity u))) -lookupClients :: MonadClient m => UserId -> m [Client] +lookupClients :: MonadClient m => UserId -> m [Client'] lookupClients u = do keys <- (\(cid, ss, Blob b) -> (cid, [(ss, LBS.toStrict b)])) @@ -449,7 +449,7 @@ toClient :: Maybe (C.Set ClientCapability), Maybe UTCTime ) -> - Client + Client' toClient keys (cid, cty, tme, lbl, cls, cok, mdl, cps, lastActive) = Client { clientId = cid, diff --git a/services/brig/src/Brig/Provider/API.hs b/services/brig/src/Brig/Provider/API.hs index d6cb9698153..3ba5857d9cd 100644 --- a/services/brig/src/Brig/Provider/API.hs +++ b/services/brig/src/Brig/Provider/API.hs @@ -123,8 +123,7 @@ import Wire.API.Team.Permission import Wire.API.User hiding (cpNewPassword, cpOldPassword) import Wire.API.User qualified as Public (UserProfile, publicProfile) import Wire.API.User.Auth -import Wire.API.User.Client -import Wire.API.User.Client qualified as Public (Client, ClientCapability (ClientSupportsLegalholdImplicitConsent), PubClient (..), UserClientPrekeyMap, UserClients, userClients) +import Wire.API.User.Client as Public import Wire.API.User.Client.Prekey qualified as Public (PrekeyId) import Wire.API.User.Identity qualified as Public (Email) import Wire.Sem.Concurrency (Concurrency, ConcurrencySafety (Unsafe)) @@ -141,7 +140,8 @@ botAPI = :<|> Named @"bot-delete-self" botDeleteSelf :<|> Named @"bot-list-prekeys" botListPrekeys :<|> Named @"bot-update-prekeys" botUpdatePrekeys - :<|> Named @"bot-get-client" botGetClient + :<|> Named @"bot-get-client-v6" botGetClientV5 + :<|> Named @"bot-get-client@v6" botGetClient :<|> Named @"bot-claim-users-prekeys" botClaimUsersPrekeys :<|> Named @"bot-list-users" botListUserProfiles :<|> Named @"bot-get-user-clients" botGetUserClients @@ -752,7 +752,10 @@ botGetSelf bot = do p <- lift $ wrapClient $ User.lookupUser NoPendingInvitations (botUserId bot) maybe (throwStd (errorToWai @'E.UserNotFound)) (pure . (`Public.publicProfile` UserLegalHoldNoConsent)) p -botGetClient :: Member GalleyProvider r => BotId -> (Handler r) (Maybe Public.Client) +botGetClientV5 :: Member GalleyProvider r => BotId -> (Handler r) (Maybe Public.ClientV5) +botGetClientV5 bot = ClientV5 <$$> botGetClient bot + +botGetClient :: Member GalleyProvider r => BotId -> (Handler r) (Maybe Public.Client') botGetClient bot = do guardSecondFactorDisabled (Just (botUserId bot)) lift $ listToMaybe <$> wrapClient (User.lookupClients (botUserId bot)) diff --git a/services/brig/src/Brig/User/Email.hs b/services/brig/src/Brig/User/Email.hs index 0a4a0a92c11..3b2c5d22297 100644 --- a/services/brig/src/Brig/User/Email.hs +++ b/services/brig/src/Brig/User/Email.hs @@ -161,7 +161,7 @@ sendNewClientEmail :: ) => Name -> Email -> - Client -> + Client' -> Locale -> m () sendNewClientEmail name email client locale = do @@ -192,7 +192,7 @@ data NewClientEmail = NewClientEmail { nclLocale :: !Locale, nclTo :: !Email, nclName :: !Name, - nclClient :: !Client + nclClient :: !Client' } renderNewClientEmail :: NewClientEmailTemplate -> NewClientEmail -> TemplateBranding -> Mail diff --git a/services/brig/test/integration/API/Federation.hs b/services/brig/test/integration/API/Federation.hs index 2f0def2baef..5129f5335b1 100644 --- a/services/brig/test/integration/API/Federation.hs +++ b/services/brig/test/integration/API/Federation.hs @@ -342,17 +342,17 @@ testClaimMultiPrekeyBundleSuccess brig fedBrigClient = do ucm ucmResponse -addTestClients :: Brig -> UserId -> [Int] -> Http [Client] +addTestClients :: Brig -> UserId -> [Int] -> Http [Client'] addTestClients brig uid idxs = for idxs $ \idx -> do let (pk, lk) = (somePrekeys !! idx, someLastPrekeys !! idx) - client :: Client <- responseJsonError =<< addClient brig uid (defNewClient PermanentClientType [pk] lk) + client :: Client' <- responseJsonError =<< addClient brig uid (defNewClient PermanentClientType [pk] lk) pure client testGetUserClients :: Brig -> FedClient 'Brig -> Http () testGetUserClients brig fedBrigClient = do uid1 <- (.userId) <$> randomUser brig - clients :: [Client] <- addTestClients brig uid1 [0, 1, 2] + clients :: [Client'] <- addTestClients brig uid1 [0, 1, 2] UserMap userClients <- runFedClient @"get-user-clients" fedBrigClient (Domain "example.com") (GetUserClients [uid1]) liftIO $ assertEqual diff --git a/services/brig/test/integration/API/Provider.hs b/services/brig/test/integration/API/Provider.hs index 0de2cdbb67a..1aace99b262 100644 --- a/services/brig/test/integration/API/Provider.hs +++ b/services/brig/test/integration/API/Provider.hs @@ -581,7 +581,7 @@ testClaimUserPrekeys config db brig galley = withTestService config db brig defS addBotResponse :: AddBotResponse <- responseJsonError =<< addBot brig u1.userId pid sid cid >= getBotSelf brig . BotId) !!! const 404 === statusCode - botClient :: Client <- responseJsonError =<< getBotClient brig bid >= getBotClient brig . BotId) !!! const 404 === statusCode bot <- svcAssertBotCreated buf bid cid diff --git a/services/brig/test/integration/API/User/Account.hs b/services/brig/test/integration/API/User/Account.hs index 4d82aa1382f..e2282c9500d 100644 --- a/services/brig/test/integration/API/User/Account.hs +++ b/services/brig/test/integration/API/User/Account.hs @@ -1759,7 +1759,7 @@ execAndAssertUserDeletion brig cannon u hdl others userJournalWatcher execDelete -- Clients are gone get (brig . path "clients" . zUser (userId u)) !!! do const 200 === statusCode - const (Just [] :: Maybe [Client]) === responseJsonMaybe + const (Just [] :: Maybe [Client']) === responseJsonMaybe -- Can no longer log in login brig (defEmailLogin email) PersistentCookie !!! do const 403 === statusCode diff --git a/services/brig/test/integration/API/User/Client.hs b/services/brig/test/integration/API/User/Client.hs index 067a2bc641d..2dbbcae9437 100644 --- a/services/brig/test/integration/API/User/Client.hs +++ b/services/brig/test/integration/API/User/Client.hs @@ -142,7 +142,7 @@ testAddGetClientVerificationCode db brig galley = do let uid = userId u let Just email = userEmail u let checkLoginSucceeds b = login brig b PersistentCookie !!! const 200 === statusCode - let addClient' :: Maybe Code.Value -> Http Client + let addClient' :: Maybe Code.Value -> Http Client' addClient' codeValue = responseJsonError =<< addClient brig uid (defNewClientWithVerificationCode codeValue PermanentClientType [head somePrekeys] (head someLastPrekeys)) Util.setTeamFeatureLockStatus @Public.SndFactorPasswordChallengeConfig galley tid Public.LockStatusUnlocked @@ -270,9 +270,9 @@ testGetUserClientsUnqualified _opts brig = do let (pk11, lk11) = (somePrekeys !! 0, someLastPrekeys !! 0) let (pk12, lk12) = (somePrekeys !! 1, someLastPrekeys !! 1) let (pk13, lk13) = (somePrekeys !! 2, someLastPrekeys !! 2) - _c11 :: Client <- responseJsonError =<< addClient brig uid1 (defNewClient PermanentClientType [pk11] lk11) - _c12 :: Client <- responseJsonError =<< addClient brig uid1 (defNewClient PermanentClientType [pk12] lk12) - _c13 :: Client <- responseJsonError =<< addClient brig uid1 (defNewClient TemporaryClientType [pk13] lk13) + _c11 :: Client' <- responseJsonError =<< addClient brig uid1 (defNewClient PermanentClientType [pk11] lk11) + _c12 :: Client' <- responseJsonError =<< addClient brig uid1 (defNewClient PermanentClientType [pk12] lk12) + _c13 :: Client' <- responseJsonError =<< addClient brig uid1 (defNewClient TemporaryClientType [pk13] lk13) getUserClientsUnqualified brig uid1 !!! do const 200 === statusCode assertTrue_ $ \res -> do @@ -286,9 +286,9 @@ testGetUserClientsQualified opts brig = do let (pk11, lk11) = (somePrekeys !! 0, someLastPrekeys !! 0) let (pk12, lk12) = (somePrekeys !! 1, someLastPrekeys !! 1) let (pk13, lk13) = (somePrekeys !! 2, someLastPrekeys !! 2) - _c11 :: Client <- responseJsonError =<< addClient brig uid1 (defNewClient PermanentClientType [pk11] lk11) - _c12 :: Client <- responseJsonError =<< addClient brig uid1 (defNewClient PermanentClientType [pk12] lk12) - _c13 :: Client <- responseJsonError =<< addClient brig uid1 (defNewClient TemporaryClientType [pk13] lk13) + _c11 :: Client' <- responseJsonError =<< addClient brig uid1 (defNewClient PermanentClientType [pk11] lk11) + _c12 :: Client' <- responseJsonError =<< addClient brig uid1 (defNewClient PermanentClientType [pk12] lk12) + _c13 :: Client' <- responseJsonError =<< addClient brig uid1 (defNewClient TemporaryClientType [pk13] lk13) let localdomain = opts ^. Opt.optionSettings & Opt.setFederationDomain getUserClientsQualified brig uid2 localdomain uid1 !!! do const 200 === statusCode @@ -748,7 +748,7 @@ testListPrekeyIds brig = do const 200 === statusCode const (Just pks) === fmap sort . responseJsonMaybe -generateClients :: Int -> Brig -> Http [(UserId, Client, ClientPrekey, ClientPrekey)] +generateClients :: Int -> Brig -> Http [(UserId, Client', ClientPrekey, ClientPrekey)] generateClients n brig = do for [1 .. n] $ \i -> do uid <- userId <$> randomUser brig diff --git a/services/galley/src/Galley/API/LegalHold/Conflicts.hs b/services/galley/src/Galley/API/LegalHold/Conflicts.hs index 4f898bd4856..db95d585865 100644 --- a/services/galley/src/Galley/API/LegalHold/Conflicts.hs +++ b/services/galley/src/Galley/API/LegalHold/Conflicts.hs @@ -115,9 +115,9 @@ guardLegalholdPolicyConflictsUid :: UserClients -> Sem r () guardLegalholdPolicyConflictsUid self (Map.keys . userClients -> otherUids) = do - allClients :: UserClientsFull <- lookupClientsFull (nub $ self : otherUids) + allClients :: UserClientsFull' <- lookupClientsFull (nub $ self : otherUids) - let allClientsMetadata :: [Client.Client] + let allClientsMetadata :: [Client.Client'] allClientsMetadata = allClients & Client.userClientsFull @@ -131,7 +131,7 @@ guardLegalholdPolicyConflictsUid self (Map.keys . userClients -> otherUids) = do anyClientIsOld :: Bool anyClientIsOld = any isOld allClientsMetadata where - isOld :: Client.Client -> Bool + isOld :: Client.Client' -> Bool isOld = (Client.ClientSupportsLegalholdImplicitConsent `Set.notMember`) . Client.fromClientCapabilityList diff --git a/services/galley/src/Galley/Effects/BrigAccess.hs b/services/galley/src/Galley/Effects/BrigAccess.hs index 642a3ab4c10..28872d8c2d0 100644 --- a/services/galley/src/Galley/Effects/BrigAccess.hs +++ b/services/galley/src/Galley/Effects/BrigAccess.hs @@ -105,7 +105,7 @@ data BrigAccess m a where GetRichInfoMultiUser :: [UserId] -> BrigAccess m [(UserId, RichInfo)] GetSize :: TeamId -> BrigAccess m TeamSize LookupClients :: [UserId] -> BrigAccess m UserClients - LookupClientsFull :: [UserId] -> BrigAccess m UserClientsFull + LookupClientsFull :: [UserId] -> BrigAccess m UserClientsFull' NotifyClientsAboutLegalHoldRequest :: UserId -> UserId -> diff --git a/services/galley/src/Galley/Intra/Client.hs b/services/galley/src/Galley/Intra/Client.hs index 5907498ad60..d8270536207 100644 --- a/services/galley/src/Galley/Intra/Client.hs +++ b/services/galley/src/Galley/Intra/Client.hs @@ -73,7 +73,7 @@ lookupClients uids = do -- | Calls 'Brig.API.internalListClientsFullH'. lookupClientsFull :: [UserId] -> - App UserClientsFull + App UserClientsFull' lookupClientsFull uids = do r <- call Brig $ @@ -157,7 +157,7 @@ removeLegalHoldClientFromUser targetUid = do . expect2xx -- | Calls 'Brig.API.addClientInternalH'. -brigAddClient :: UserId -> ConnId -> NewClient -> App (Either AuthenticationError Client) +brigAddClient :: UserId -> ConnId -> NewClient -> App (Either AuthenticationError Client') brigAddClient uid connId client = do r <- call Brig $ diff --git a/services/galley/test/integration/API/Teams/LegalHold/Util.hs b/services/galley/test/integration/API/Teams/LegalHold/Util.hs index f4362f81507..c1d77cf3d89 100644 --- a/services/galley/test/integration/API/Teams/LegalHold/Util.hs +++ b/services/galley/test/integration/API/Teams/LegalHold/Util.hs @@ -428,7 +428,7 @@ disableLegalHoldForUser' g mPassword tid zusr uid = do assertExactlyOneLegalHoldDevice :: HasCallStack => UserId -> TestM () assertExactlyOneLegalHoldDevice uid = do - clients :: [Client] <- + clients :: [Client'] <- getClients uid >>= responseJsonError liftIO $ do let numdevs = length $ clientType <$> clients @@ -436,7 +436,7 @@ assertExactlyOneLegalHoldDevice uid = do assertZeroLegalHoldDevices :: HasCallStack => UserId -> TestM () assertZeroLegalHoldDevices uid = do - clients :: [Client] <- + clients :: [Client'] <- getClients uid >>= responseJsonError liftIO $ do let numdevs = length $ clientType <$> clients diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index e9ca4a544c8..5d129e9fd58 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -2228,7 +2228,7 @@ getClients u = do . zUser u . zConn "conn" -getInternalClientsFull :: UserSet -> TestM UserClientsFull +getInternalClientsFull :: UserSet -> TestM UserClientsFull' getInternalClientsFull userSet = do b <- viewBrig res <- diff --git a/tools/stern/src/Stern/Intra.hs b/tools/stern/src/Stern/Intra.hs index 685e6541236..837d1e1cd73 100644 --- a/tools/stern/src/Stern/Intra.hs +++ b/tools/stern/src/Stern/Intra.hs @@ -813,7 +813,7 @@ getUserConversations uid maxConvs = do ) unVersioned @'V2 <$> parseResponse (mkError status502 "bad-upstream") r -getUserClients :: UserId -> Handler [Client] +getUserClients :: UserId -> Handler [Client'] getUserClients uid = do info $ msg "Getting user clients" b <- view brig