core add chat_recv_msg_wait and chat_parse_markdown to published API (#736)

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

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)
 

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