Use string-typed client field in message protobuf

changelog.d/3-bug-fixes/fix-client-id-types

@@ -0,0 +1 @@
+Use string-typed client field in message protobuf

integration/test/API/Galley.hs

@@ -13,8 +13,8 @@ import Data.ByteString.Char8 qualified as BS
 import Data.ByteString.Lazy qualified as LBS
 import Data.ProtoLens qualified as Proto
 import Data.ProtoLens.Labels ()
+import Data.Text qualified as T
 import Data.UUID qualified as UUID
-import Numeric.Lens
 import Proto.Otr as Proto
 import Testlib.Prelude
 
@@ -244,7 +244,7 @@ mkProteusRecipients dom userClients msg = do
           & #user . #uuid .~ userId
           & #clients .~ clientEntries
     mkClientEntry client = do
-      clientId <- (^?! hex) <$> objId client
+      clientId <- T.pack <$> asString client
       pure $
         Proto.defMessage
           & #client . #client .~ clientId

integration/test/Test/Federation.hs

@@ -9,8 +9,8 @@ import Control.Monad.Codensity
 import Control.Monad.Reader
 import Data.ProtoLens qualified as Proto
 import Data.ProtoLens.Labels ()
+import Data.Text qualified as T
 import Notifications
-import Numeric.Lens
 import Proto.Otr qualified as Proto
 import Proto.Otr_Fields qualified as Proto
 import SetupHelpers
@@ -51,7 +51,7 @@ testNotificationsForOfflineBackends = do
       successfulMsgForDownUser <- mkProteusRecipient downUser1 downClient1 "success message for down user"
       let successfulMsg =
             Proto.defMessage @Proto.QualifiedNewOtrMessage
-              & #sender . Proto.client .~ (delClient ^?! hex)
+              & #sender . Proto.client .~ T.pack delClient
               & #recipients .~ [successfulMsgForOtherUsers, successfulMsgForDownUser]
               & #reportAll .~ Proto.defMessage
       bindResponse (postProteusMessage delUser upBackendConv successfulMsg) assertSuccess
@@ -61,7 +61,7 @@ testNotificationsForOfflineBackends = do
       failedMsgForDownUser <- mkProteusRecipient downUser1 downClient1 "failed message for down user"
       let failedMsg =
             Proto.defMessage @Proto.QualifiedNewOtrMessage
-              & #sender . Proto.client .~ (delClient ^?! hex)
+              & #sender . Proto.client .~ T.pack delClient
               & #recipients .~ [failedMsgForOtherUser, failedMsgForDownUser]
               & #reportAll .~ Proto.defMessage
       bindResponse (postProteusMessage delUser downBackendConv failedMsg) $ \resp ->

libs/types-common/src/Data/Id.hs

@@ -43,6 +43,7 @@ module Data.Id
     -- * Client IDs
     ClientId (..),
     newClientId,
+    clientIdFromText,
 
     -- * Other IDs
     ConnId (..),
@@ -315,24 +316,24 @@ newtype ClientId = ClientId
   deriving (FromJSON, ToJSON, S.ToSchema) via Schema ClientId
 
 instance ToSchema ClientId where
-  schema = client .= parsedText "ClientId" clientIdFromByteString
+  schema = client .= parsedText "ClientId" clientIdFromText
 
 newClientId :: Word64 -> ClientId
 newClientId = ClientId . toStrict . toLazyText . hexadecimal
 
-clientIdFromByteString :: Text -> Either String ClientId
-clientIdFromByteString txt =
+clientIdFromText :: Text -> Either String ClientId
+clientIdFromText txt =
   if T.length txt <= 20 && T.all isHexDigit txt
     then Right $ ClientId txt
     else Left "Invalid ClientId"
 
 instance FromByteString ClientId where
   parser = do
     bs <- Atto.takeByteString
-    either fail pure $ clientIdFromByteString (cs bs)
+    either fail pure $ clientIdFromText (cs bs)
 
 instance A.FromJSONKey ClientId where
-  fromJSONKey = A.FromJSONKeyTextParser $ either fail pure . clientIdFromByteString
+  fromJSONKey = A.FromJSONKeyTextParser $ either fail pure . clientIdFromText
 
 deriving instance Cql ClientId
 

libs/wire-api/src/Wire/API/Message.hs

@@ -59,7 +59,8 @@ module Wire.API.Message
   )
 where
 
-import Control.Lens (view, (.~), (?~))
+import Control.Lens (preview, view, (.~), (?~))
+import Control.Monad.Trans.Maybe
 import Data.Aeson qualified as A
 import Data.ByteString.Lazy qualified as LBS
 import Data.CommaSeparatedList (CommaSeparatedList (fromCommaSeparatedList))
@@ -75,7 +76,6 @@ import Data.Qualified (Qualified (..))
 import Data.Schema
 import Data.Serialize (runGet)
 import Data.Set qualified as Set
-import Data.Text.Read qualified as Reader
 import Data.UUID qualified as UUID
 import Imports
 import Proto.Otr qualified
@@ -221,11 +221,12 @@ instance ToProto QualifiedNewOtrMessage where
 
 protolensToQualifiedNewOtrMessage :: Proto.Otr.QualifiedNewOtrMessage -> Either String QualifiedNewOtrMessage
 protolensToQualifiedNewOtrMessage protoMsg = do
+  sender <- protolensToClientId $ view Proto.Otr.sender protoMsg
   recipients <- protolensOtrRecipientsToOtrRecipients $ view Proto.Otr.recipients protoMsg
   strat <- protolensToClientMismatchStrategy $ view Proto.Otr.maybe'clientMismatchStrategy protoMsg
   pure $
     QualifiedNewOtrMessage
-      { qualifiedNewOtrSender = protolensToClientId $ view Proto.Otr.sender protoMsg,
+      { qualifiedNewOtrSender = sender,
         qualifiedNewOtrRecipients = recipients,
         qualifiedNewOtrNativePush = view Proto.Otr.nativePush protoMsg,
         qualifiedNewOtrTransient = view Proto.Otr.transient protoMsg,
@@ -234,8 +235,12 @@ protolensToQualifiedNewOtrMessage protoMsg = do
         qualifiedNewOtrClientMismatchStrategy = strat
       }
 
-protolensToClientId :: Proto.Otr.ClientId -> ClientId
-protolensToClientId = newClientId . view Proto.Otr.client
+protolensToClientId :: Proto.Otr.ClientId -> Either String ClientId
+protolensToClientId proto = fmap (fromMaybe legacy) . runMaybeT $ do
+  client <- maybe mzero pure $ preview Proto.Otr.client proto
+  lift $ clientIdFromText client
+  where
+    legacy = newClientId $ view Proto.Otr.clientLegacy proto
 
 qualifiedNewOtrMessageToProto :: QualifiedNewOtrMessage -> Proto.Otr.QualifiedNewOtrMessage
 qualifiedNewOtrMessageToProto msg =
@@ -276,7 +281,7 @@ mkQualifiedOtrPayload sender entries dat strat =
 clientIdToProtolens :: ClientId -> Proto.Otr.ClientId
 clientIdToProtolens cid =
   ProtoLens.defMessage
-    & Proto.Otr.client .~ (either error fst . Reader.hexadecimal $ client cid)
+    & Proto.Otr.client .~ client cid
 
 --------------------------------------------------------------------------------
 -- Priority
@@ -383,7 +388,7 @@ protolensOtrRecipientsToOtrRecipients entries =
     parseClientMap entry = parseMap parseClientId parseText $ view Proto.Otr.clients entry
 
     parseClientId :: Proto.Otr.ClientEntry -> Either String ClientId
-    parseClientId = pure . protolensToClientId . view Proto.Otr.client
+    parseClientId = protolensToClientId . view Proto.Otr.client
 
     parseText :: Proto.Otr.ClientEntry -> Either String ByteString
     parseText = pure . view Proto.Otr.text

libs/wire-api/wire-api.cabal

@@ -314,6 +314,7 @@ library
     , tagged
     , text                       >=0.11
     , time                       >=1.4
+    , transformers
     , transitive-anns
     , types-common               >=0.16
     , unordered-containers       >=0.2