Recognise wrong QR code type in every scanner

When a scanner is shown a QR code of a different kind than it expects, it
now tells the user what they actually scanned and where to use it, instead
of a generic "invalid" message.

Link recognition is done in the core: a new chat_check_link export
classifies a scanned string using the same decoders the views use to
process the links (connection link, server address, migration file link,
desktop address, security code), returning a typed result. Each scanner
calls checkLink first; the expected type proceeds to that scanner's normal
success path, a recognised-but-wrong type shows a shared wrong-type alert
saying what it is and where to use it, and an unrecognised string falls
back to that scanner's own contextual error. Mirrored on Android, desktop
and iOS.

Note: the iOS Swift was written without an Xcode toolchain and is not yet
compiled — needs a Mac/CI build to verify.

src/Simplex/Chat/Controller.hs

@@ -58,6 +58,7 @@ import Simplex.Chat.Call
 import Simplex.Chat.Delivery
 import Simplex.Chat.Messages
 import Simplex.Chat.Messages.CIContent
+import Simplex.Chat.Markdown (SimplexLinkType (..))
 import Simplex.Chat.Operators
 import Simplex.Chat.Protocol
 import Simplex.Chat.Remote.AppVersion
@@ -1390,6 +1391,20 @@ data ServerAddress = ServerAddress
   }
   deriving (Show)
 
+-- The kinds of QR code / link the app knows how to scan, for chat_check_link.
+-- A scanner that rejects a scan passes the text here to learn what it actually
+-- was, so it can tell the user where to use it.
+data ScannedLinkType
+  = SLTConnection {linkType :: SimplexLinkType} -- connection link; subtype reuses markdown's enum
+  | SLTServer -- SMP/XFTP server address
+  | SLTFileDescription -- migration / standalone file link
+  | SLTDesktopCtrl -- desktop session address (xrcp)
+  | SLTVerificationCode -- contact's security code
+  deriving (Eq, Show)
+
+newtype CheckedLink = CheckedLink {linkType :: Maybe ScannedLinkType} -- Nothing = not a SimpleX QR code
+  deriving (Eq, Show)
+
 data TimedMessagesEnabled
   = TMEEnableSetTTL Int
   | TMEEnableKeepTTL
@@ -1844,6 +1859,10 @@ $(JQ.deriveJSON defaultJSON ''ServerAddress)
 
 $(JQ.deriveJSON defaultJSON ''ParsedServerAddress)
 
+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "SLT") ''ScannedLinkType)
+
+$(JQ.deriveJSON defaultJSON ''CheckedLink)
+
 $(JQ.deriveJSON defaultJSON ''ChatItemDeletion)
 
 $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "ServiceSub") ''ServiceSubEvent)

src/Simplex/Chat/Markdown.hs

@@ -353,30 +353,40 @@ markdownP = mconcat <$> A.many' fragmentP
     isEmail s = T.any (== '@') s && Email.isValid (encodeUtf8 s)
     noFormat = pure . unmarked
     simplexUriFormat :: Maybe Text -> AConnectionLink -> Format
-    simplexUriFormat showText = \case
-      ACL m (CLFull cReq) -> case cReq of
-        CRContactUri crData _ -> SimplexLink showText (linkType' crData) cLink $ uriHosts crData
-        CRInvitationUri crData _ -> SimplexLink showText XLInvitation cLink $ uriHosts crData
+    simplexUriFormat showText aLink@(ACL m cl) = case cl of
+      CLFull cReq -> case cReq of
+        CRContactUri crData _ -> mk $ uriHosts crData
+        CRInvitationUri crData _ -> mk $ uriHosts crData
         where
-          cLink = ACL m $ CLFull $ simplexConnReqUri cReq
+          mk = SimplexLink showText (simplexLinkType aLink) (ACL m $ CLFull $ simplexConnReqUri cReq)
           uriHosts ConnReqUriData {crSmpQueues} = L.map strEncodeText $ sconcat $ L.map (host . qServer) crSmpQueues
-          linkType' ConnReqUriData {crClientData} = case crClientData >>= decodeJSON of
-            Just (CRDataGroup _) -> XLGroup
-            Nothing -> XLContact
-      ACL m (CLShort sLnk) -> case sLnk of
-        CSLContact _ ct srv _ -> SimplexLink showText (linkType' ct) cLink $ uriHosts srv
-        CSLInvitation _ srv _ _ -> SimplexLink showText XLInvitation cLink $ uriHosts srv
+      CLShort sLnk -> case sLnk of
+        CSLContact _ _ srv _ -> mk $ uriHosts srv
+        CSLInvitation _ srv _ _ -> mk $ uriHosts srv
         where
-          cLink = ACL m $ CLShort $ simplexShortLink sLnk
+          mk = SimplexLink showText (simplexLinkType aLink) (ACL m $ CLShort $ simplexShortLink sLnk)
           uriHosts srv = L.map strEncodeText $ host srv
-          linkType' = \case
-            CCTGroup -> XLGroup
-            CCTChannel -> XLChannel
-            CCTContact -> XLContact
-            CCTRelay -> XLRelay
     strEncodeText :: StrEncoding a => a -> Text
     strEncodeText = safeDecodeUtf8 . strEncode
 
+-- The single definition of connection-link kind classification, used by the chat
+-- markdown formatter (simplexUriFormat) and by the mobile link classifier
+-- (chatCheckLink). Group links are contact URIs carrying CRDataGroup client data.
+simplexLinkType :: AConnectionLink -> SimplexLinkType
+simplexLinkType (ACL _ cl) = case cl of
+  CLFull cReq -> case cReq of
+    CRContactUri ConnReqUriData {crClientData} _ -> case crClientData >>= decodeJSON of
+      Just (CRDataGroup _) -> XLGroup
+      Nothing -> XLContact
+    CRInvitationUri {} -> XLInvitation
+  CLShort sLnk -> case sLnk of
+    CSLContact _ ct _ _ -> case ct of
+      CCTGroup -> XLGroup
+      CCTChannel -> XLChannel
+      CCTContact -> XLContact
+      CCTRelay -> XLRelay
+    CSLInvitation {} -> XLInvitation
+
 parseUri :: ByteString -> Either Text U.URI
 parseUri s = case U.parseURI U.laxURIParserOptions s of
   Left e -> Left $ "Invalid URI: " <> tshow e

src/Simplex/Chat/Mobile.hs

@@ -37,7 +37,7 @@ import GHC.IO.Encoding (setFileSystemEncoding, setForeignEncoding, setLocaleEnco
 import Simplex.Chat
 import Simplex.Chat.Controller
 import Simplex.Chat.Library.Commands
-import Simplex.Chat.Markdown (ParsedMarkdown (..), parseMaybeMarkdownList, parseUri, sanitizeUri)
+import Simplex.Chat.Markdown (ParsedMarkdown (..), parseMaybeMarkdownList, parseUri, sanitizeUri, simplexLinkType)
 import Simplex.Chat.Mobile.Badges
 import Simplex.Chat.Mobile.File
 import Simplex.Chat.Mobile.Shared
@@ -48,9 +48,10 @@ import Simplex.Chat.Remote.Types
 import Simplex.Chat.Store
 import Simplex.Chat.Store.Profiles
 import Simplex.Chat.Types
+import Simplex.FileTransfer.Description (FileDescriptionURI)
 import Simplex.Messaging.Agent.Client (agentClientStore)
 import Simplex.Messaging.Agent.Env.SQLite (createAgentStore)
-import Simplex.Messaging.Agent.Protocol (AgentErrorType)
+import Simplex.Messaging.Agent.Protocol (AConnectionLink, AgentErrorType)
 import Simplex.Messaging.Agent.Store.Interface (closeDBStore, reopenDBStore)
 import Simplex.Messaging.Agent.Store.Shared (MigrationConfig (..), MigrationConfirmation (..), MigrationError)
 import qualified Simplex.Messaging.Crypto as C
@@ -58,6 +59,7 @@ import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, sumTypeJSON)
 import Simplex.Messaging.Protocol (AProtoServerWithAuth (..), AProtocolType (..), BasicAuth (..), ProtoServerWithAuth (..), ProtocolServer (..))
 import Simplex.Messaging.Util (catchAll, liftEitherWith, safeDecodeUtf8)
+import Simplex.RemoteControl.Invitation (RCSignedInvitation)
 import System.IO (utf8)
 import System.Timeout (timeout)
 import qualified URI.ByteString as U
@@ -131,6 +133,8 @@ foreign export ccall "chat_parse_markdown" cChatParseMarkdown :: CString -> IO C
 
 foreign export ccall "chat_parse_server" cChatParseServer :: CString -> IO CJSONString
 
+foreign export ccall "chat_check_link" cChatCheckLink :: CString -> IO CJSONString
+
 foreign export ccall "chat_parse_uri" cChatParseUri :: CString -> CInt -> IO CJSONString
 
 foreign export ccall "chat_password_hash" cChatPasswordHash :: CString -> CString -> IO CString
@@ -226,6 +230,10 @@ cChatParseMarkdown s = newCStringFromLazyBS . chatParseMarkdown =<< B.packCStrin
 cChatParseServer :: CString -> IO CJSONString
 cChatParseServer s = newCStringFromLazyBS . chatParseServer =<< B.packCString s
 
+-- | classify a scanned QR code / link - returns CheckedLink JSON
+cChatCheckLink :: CString -> IO CJSONString
+cChatCheckLink s = newCStringFromLazyBS . chatCheckLink =<< B.packCString s
+
 -- | parse web URI - returns ParsedUri JSON
 cChatParseUri :: CString -> CInt -> IO CJSONString
 cChatParseUri s safe = newCStringFromLazyBS . chatParseUri (safe /= 0) =<< B.packCString s
@@ -381,6 +389,23 @@ chatParseServer = J.encode . toServerAddress . strDecode
     enc :: StrEncoding a => a -> String
     enc = B.unpack . strEncode
 
+-- | Classify a scanned QR code / link into ScannedLinkType, or Nothing if it is
+-- not a SimpleX code, by trying the same core decoders that later process each
+-- kind. The UI owns the real trim (see the plan); this ASCII-only trim is
+-- defensive so a stray edge byte never fails an otherwise-valid decode.
+chatCheckLink :: ByteString -> JSONByteString
+chatCheckLink = J.encode . CheckedLink . classify . trimAscii
+  where
+    isAsciiSpace c = c == ' ' || c == '\t' || c == '\r' || c == '\n'
+    trimAscii = B.dropWhileEnd isAsciiSpace . B.dropWhile isAsciiSpace
+    classify s
+      | Right {} <- strDecode @RCSignedInvitation s = Just SLTDesktopCtrl
+      | Right {} <- strDecode @FileDescriptionURI s = Just SLTFileDescription
+      | Right l <- strDecode @AConnectionLink s = Just $ SLTConnection $ simplexLinkType l
+      | Right {} <- strDecode @AProtoServerWithAuth s = Just SLTServer
+      | isVerificationCode s = Just SLTVerificationCode
+      | otherwise = Nothing
+
 chatParseUri :: Bool -> ByteString -> JSONByteString
 chatParseUri safe s = J.encode $ case parseUri s of
   Left e -> ParsedUri Nothing e

src/Simplex/Chat/Types.hs

@@ -1950,6 +1950,20 @@ verificationCode = T.pack . unwords . chunks 5 . show . os2ip
     chunks _ [] = []
     chunks n xs = let (h, t) = splitAt n xs in h : chunks n t
 
+-- Recognises the textual shape of a verification code — the inverse of
+-- verificationCode's `unwords . chunks 5 . show`: space-separated groups of
+-- exactly 5 ASCII digits (the last group 1-5 digits), 32+ digits in total.
+-- Used by chatCheckLink to classify a scanned contact security code, which has
+-- no scheme to parse. Requiring the grouping keeps a bare long number out.
+isVerificationCode :: ByteString -> Bool
+isVerificationCode s = case B.split ' ' s of
+  [] -> False
+  gs -> all full5 (init gs) && lastOk (last gs) && sum (map B.length gs) >= 32
+  where
+    isAsciiDigit c = c >= '0' && c <= '9'
+    full5 g = B.length g == 5 && B.all isAsciiDigit g
+    lastOk g = let n = B.length g in n >= 1 && n <= 5 && B.all isAsciiDigit g
+
 sameVerificationCode :: Text -> Text -> Bool
 sameVerificationCode c1 c2 = noSpaces c1 == noSpaces c2
   where