diff --git a/src/Simplex/Chat/Markdown.hs b/src/Simplex/Chat/Markdown.hs index 8242d4651..1708659f4 100644 --- a/src/Simplex/Chat/Markdown.hs +++ b/src/Simplex/Chat/Markdown.hs @@ -89,6 +89,13 @@ instance IsString FormattedText where type MarkdownList = [FormattedText] +data ParsedMarkdown = ParsedMarkdown {formattedText :: Maybe MarkdownList} + deriving (Generic) + +instance ToJSON ParsedMarkdown where + toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True} + toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True} + unmarked :: Text -> Markdown unmarked = Markdown Nothing @@ -183,6 +190,6 @@ markdownP = mconcat <$> A.many' fragmentP | isUri s = markdown Uri s | isEmail s = markdown Email s | otherwise = unmarked s - isUri s = "http://" `T.isPrefixOf` s || "https://" `T.isPrefixOf` s || "simplex:/" `T.isPrefixOf` s + isUri s = T.length s >= 10 && any (`T.isPrefixOf` s) ["http://", "https://", "simplex:/"] isEmail s = T.any (== '@') s && Email.isValid (encodeUtf8 s) noFormat = pure . unmarked diff --git a/src/Simplex/Chat/Mobile.hs b/src/Simplex/Chat/Mobile.hs index 74d06f283..c08966643 100644 --- a/src/Simplex/Chat/Mobile.hs +++ b/src/Simplex/Chat/Mobile.hs @@ -12,16 +12,21 @@ import qualified Data.Aeson as J import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as LB import Data.List (find) +import Data.Maybe (fromMaybe) import Foreign.C.String +import Foreign.C.Types (CInt (..)) import Foreign.StablePtr import GHC.Generics (Generic) import Simplex.Chat import Simplex.Chat.Controller +import Simplex.Chat.Markdown (ParsedMarkdown (..), parseMaybeMarkdownList) import Simplex.Chat.Options import Simplex.Chat.Store import Simplex.Chat.Types +import Simplex.Chat.Util (safeDecodeUtf8) import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (yesToMigrations)) import Simplex.Messaging.Protocol (CorrId (..)) +import System.Timeout (timeout) foreign export ccall "chat_init" cChatInit :: CString -> IO (StablePtr ChatController) @@ -29,6 +34,10 @@ foreign export ccall "chat_send_cmd" cChatSendCmd :: StablePtr ChatController -> foreign export ccall "chat_recv_msg" cChatRecvMsg :: StablePtr ChatController -> IO CJSONString +foreign export ccall "chat_recv_msg_wait" cChatRecvMsgWait :: StablePtr ChatController -> CInt -> IO CJSONString + +foreign export ccall "chat_parse_markdown" cChatParseMarkdown :: CString -> IO CJSONString + -- | initialize chat controller -- The active user has to be created and the chat has to be started before most commands can be used. cChatInit :: CString -> IO (StablePtr ChatController) @@ -45,6 +54,14 @@ cChatSendCmd cPtr cCmd = do cChatRecvMsg :: StablePtr ChatController -> IO CJSONString cChatRecvMsg cc = deRefStablePtr cc >>= chatRecvMsg >>= newCAString +-- | receive message from chat (blocking up to `t` microseconds (1/10^6 sec), returns empty string if times out) +cChatRecvMsgWait :: StablePtr ChatController -> CInt -> IO CJSONString +cChatRecvMsgWait cc t = deRefStablePtr cc >>= (`chatRecvMsgWait` fromIntegral t) >>= newCAString + +-- | parse markdown - returns ParsedMarkdown type JSON +cChatParseMarkdown :: CString -> IO CJSONString +cChatParseMarkdown s = newCAString . chatParseMarkdown =<< peekCAString s + mobileChatOpts :: ChatOpts mobileChatOpts = ChatOpts @@ -85,6 +102,12 @@ chatRecvMsg ChatController {outputQ} = json <$> atomically (readTBQueue outputQ) where json (corr, resp) = LB.unpack $ J.encode APIResponse {corr, resp} +chatRecvMsgWait :: ChatController -> Int -> IO JSONString +chatRecvMsgWait cc time = fromMaybe "" <$> timeout time (chatRecvMsg cc) + +chatParseMarkdown :: String -> JSONString +chatParseMarkdown = LB.unpack . J.encode . ParsedMarkdown . parseMaybeMarkdownList . safeDecodeUtf8 . B.pack + data APIResponse = APIResponse {corr :: Maybe CorrId, resp :: ChatResponse} deriving (Generic) diff --git a/tests/MobileTests.hs b/tests/MobileTests.hs index 9e73060f9..399636521 100644 --- a/tests/MobileTests.hs +++ b/tests/MobileTests.hs @@ -43,6 +43,34 @@ chatStarted = "{\"resp\":{\"chatStarted\":{}}}" chatStarted = "{\"resp\":{\"type\":\"chatStarted\"}}" #endif +contactSubSummary :: String +#if defined(darwin_HOST_OS) && defined(swiftJSON) +contactSubSummary = "{\"resp\":{\"contactSubSummary\":{\"contactSubscriptions\":[]}}}" +#else +contactSubSummary = "{\"resp\":{\"type\":\"contactSubSummary\",\"contactSubscriptions\":[]}}" +#endif + +memberSubErrors :: String +#if defined(darwin_HOST_OS) && defined(swiftJSON) +memberSubErrors = "{\"resp\":{\"memberSubErrors\":{\"memberSubErrors\":[]}}}" +#else +memberSubErrors = "{\"resp\":{\"type\":\"memberSubErrors\",\"memberSubErrors\":[]}}" +#endif + +pendingSubSummary :: String +#if defined(darwin_HOST_OS) && defined(swiftJSON) +pendingSubSummary = "{\"resp\":{\"pendingSubSummary\":{\"pendingSubStatus\":[]}}}" +#else +pendingSubSummary = "{\"resp\":{\"type\":\"pendingSubSummary\",\"pendingSubStatus\":[]}}" +#endif + +parsedMarkdown :: String +#if defined(darwin_HOST_OS) && defined(swiftJSON) +parsedMarkdown = "{\"formattedText\":[{\"format\":{\"bold\":{}},\"text\":\"hello\"}]}" +#else +parsedMarkdown = "{\"formattedText\":[{\"format\":{\"type\":\"bold\"},\"text\":\"hello\"}]}" +#endif + testChatApiNoUser :: IO () testChatApiNoUser = withTmpFiles $ do cc <- chatInit testDBPrefix @@ -60,3 +88,9 @@ testChatApi = withTmpFiles $ do chatSendCmd cc "/u" `shouldReturn` activeUser chatSendCmd cc "/u alice Alice" `shouldReturn` activeUserExists chatSendCmd cc "/_start" `shouldReturn` chatStarted + chatRecvMsg cc `shouldReturn` contactSubSummary + chatRecvMsg cc `shouldReturn` memberSubErrors + chatRecvMsgWait cc 10000 `shouldReturn` pendingSubSummary + chatRecvMsgWait cc 10000 `shouldReturn` "" + chatParseMarkdown "hello" `shouldBe` "{}" + chatParseMarkdown "*hello*" `shouldBe` parsedMarkdown