dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-04-26 17:27:57 +00:00
Code Issues Packages Projects Releases Wiki Activity

core, ui: markdown for hyperlinks, warn on unsanitized links, option to sanitize sent links (#6160)

Browse Source 
* core: markdown for "hidden" links

* update, test

* api docs

* chatParseUri FFI function

* ios: hyperlinks, offer to open sanitized links, an option to send sanitized links (enabled by default)

* update markdown

* android, desktop: ditto

* ios: export localizations

* core: rename constructor, change Maybe semantics for web links

* rename
This commit is contained in:
Evgeny
2025-08-09 10:52:35 +01:00
committed by GitHub
parent b4293e361b
commit ef60ceea12
55 changed files with 1004 additions and 288 deletions
Download Patch File Download Diff File Expand all files Collapse all files

34
src/Simplex/Chat/Mobile.hs
View File

@@ -1,5 +1,6 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
@@ -25,6 +26,7 @@ import Data.Functor (($>))
import Data.List (find)
import qualified Data.List.NonEmpty as L
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Word (Word8)
import Foreign.C.String
import Foreign.C.Types (CInt (..))
@@ -35,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)
import Simplex.Chat.Markdown (ParsedMarkdown (..), parseMaybeMarkdownList, parseUri, sanitizeUri)
import Simplex.Chat.Mobile.File
import Simplex.Chat.Mobile.Shared
import Simplex.Chat.Mobile.WebRTC
@@ -56,6 +58,7 @@ import Simplex.Messaging.Protocol (AProtoServerWithAuth (..), AProtocolType (..)
import Simplex.Messaging.Util (catchAll, liftEitherWith, safeDecodeUtf8)
import System.IO (utf8)
import System.Timeout (timeout)
import qualified URI.ByteString as U
#if !defined(dbPostgres)
import Data.ByteArray (ScrubbedBytes)
import Database.SQLite.Simple (SQLError (..))
@@ -81,6 +84,20 @@ eitherToResult :: Maybe RemoteHostId -> Either ChatError r -> APIResult r
eitherToResult rhId = either (APIError rhId) (APIResult rhId)
{-# INLINE eitherToResult #-}
data ParsedUri = ParsedUri
{ uriInfo :: Maybe UriInfo,
parseError :: Text
}
data UriInfo = UriInfo
{ scheme :: Text,
sanitized :: Maybe Text
}
$(JQ.deriveJSON defaultJSON ''UriInfo)
$(JQ.deriveJSON defaultJSON ''ParsedUri)
$(pure [])
instance ToJSON r => ToJSON (APIResult r) where
@@ -111,6 +128,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_parse_uri" cChatParseUri :: CString -> IO CJSONString
foreign export ccall "chat_password_hash" cChatPasswordHash :: CString -> CString -> IO CString
foreign export ccall "chat_valid_name" cChatValidName :: CString -> IO CString
@@ -200,6 +219,10 @@ cChatParseMarkdown s = newCStringFromLazyBS . chatParseMarkdown =<< B.packCStrin
cChatParseServer :: CString -> IO CJSONString
cChatParseServer s = newCStringFromLazyBS . chatParseServer =<< B.packCString s
-- | parse web URI - returns ParsedUri JSON
cChatParseUri :: CString -> IO CJSONString
cChatParseUri s = newCStringFromLazyBS . chatParseUri =<< B.packCString s
cChatPasswordHash :: CString -> CString -> IO CString
cChatPasswordHash cPwd cSalt = do
pwd <- B.packCString cPwd
@@ -293,6 +316,7 @@ chatMigrateInitKey chatDbOpts keepKey confirm backgroundMode = runExceptT $ do
DB.ErrorNotADatabase -> Left $ DBMErrorNotADatabase errDbStr
_ -> dbError e
#endif
dbError :: Show e => e -> Either DBMigrationResult DBStore
dbError e = Left . DBMErrorSQL errDbStr $ show e
chatCloseStore :: ChatController -> IO String
@@ -342,6 +366,14 @@ chatParseServer = J.encode . toServerAddress . strDecode
enc :: StrEncoding a => a -> String
enc = B.unpack . strEncode
chatParseUri :: ByteString -> JSONByteString
chatParseUri s = J.encode $ case parseUri s of
Left e -> ParsedUri Nothing e
Right uri@U.URI {uriScheme = U.Scheme sch} ->
let sanitized = safeDecodeUtf8 . U.serializeURIRef' <$> sanitizeUri uri
uriInfo = UriInfo {scheme = safeDecodeUtf8 sch, sanitized}
in ParsedUri (Just uriInfo) ""
chatPasswordHash :: ByteString -> ByteString -> ByteString
chatPasswordHash pwd salt = either (const "") passwordHash salt'
where