core: optimize C apis (#3100)

* core: optimize C apis

* more

* fix tests

* use pokeByteOff

* write lazy bytestring to buffer without conversion to strict

* avoid conversion of JSON to strict bytestrings

src/Simplex/Chat/Mobile.hs

@@ -14,14 +14,12 @@ import Data.Aeson (ToJSON (..))
 import qualified Data.Aeson as J
 import Data.Bifunctor (first)
 import qualified Data.ByteString.Base64.URL as U
+import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
-import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Functor (($>))
 import Data.List (find)
 import qualified Data.List.NonEmpty as L
 import Data.Maybe (fromMaybe)
-import qualified Data.Text as T
-import Data.Text.Encoding (encodeUtf8)
 import Data.Word (Word8)
 import Database.SQLite.Simple (SQLError (..))
 import qualified Database.SQLite.Simple as DB
@@ -95,36 +93,36 @@ cChatMigrateInit fp key conf ctrl = do
     chatMigrateInit dbPath dbKey confirm >>= \case
       Right cc -> (newStablePtr cc >>= poke ctrl) $> DBMOk
       Left e -> pure e
-  newCAString . LB.unpack $ J.encode r
+  newCStringFromLazyBS $ J.encode r
 
 -- | send command to chat (same syntax as in terminal for now)
 cChatSendCmd :: StablePtr ChatController -> CString -> IO CJSONString
 cChatSendCmd cPtr cCmd = do
   c <- deRefStablePtr cPtr
-  cmd <- peekCAString cCmd
-  newCAString =<< chatSendCmd c cmd
+  cmd <- B.packCString cCmd
+  newCStringFromLazyBS =<< chatSendCmd c cmd
 
 -- | receive message from chat (blocking)
 cChatRecvMsg :: StablePtr ChatController -> IO CJSONString
-cChatRecvMsg cc = deRefStablePtr cc >>= chatRecvMsg >>= newCAString
+cChatRecvMsg cc = deRefStablePtr cc >>= chatRecvMsg >>= newCStringFromLazyBS
 
 -- |  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
+cChatRecvMsgWait cc t = deRefStablePtr cc >>= (`chatRecvMsgWait` fromIntegral t) >>= newCStringFromLazyBS
 
 -- | parse markdown - returns ParsedMarkdown type JSON
 cChatParseMarkdown :: CString -> IO CJSONString
-cChatParseMarkdown s = newCAString . chatParseMarkdown =<< peekCAString s
+cChatParseMarkdown s = newCStringFromLazyBS . chatParseMarkdown =<< B.packCString s
 
 -- | parse server address - returns ParsedServerAddress JSON
 cChatParseServer :: CString -> IO CJSONString
-cChatParseServer s = newCAString . chatParseServer =<< peekCAString s
+cChatParseServer s = newCStringFromLazyBS . chatParseServer =<< B.packCString s
 
 cChatPasswordHash :: CString -> CString -> IO CString
 cChatPasswordHash cPwd cSalt = do
-  pwd <- peekCAString cPwd
-  salt <- peekCAString cSalt
-  newCAString $ chatPasswordHash pwd salt
+  pwd <- B.packCString cPwd
+  salt <- B.packCString cSalt
+  newCStringFromBS $ chatPasswordHash pwd salt
 
 mobileChatOpts :: String -> String -> ChatOpts
 mobileChatOpts dbFilePrefix dbKey =
@@ -197,22 +195,22 @@ chatMigrateInit dbFilePrefix dbKey confirm = runExceptT $ do
           _ -> dbError e
         dbError e = Left . DBMErrorSQL dbFile $ show e
 
-chatSendCmd :: ChatController -> String -> IO JSONString
-chatSendCmd cc s = LB.unpack . J.encode . APIResponse Nothing <$> runReaderT (execChatCommand $ B.pack s) cc
+chatSendCmd :: ChatController -> ByteString -> IO JSONByteString
+chatSendCmd cc s = J.encode . APIResponse Nothing <$> runReaderT (execChatCommand s) cc
 
-chatRecvMsg :: ChatController -> IO JSONString
+chatRecvMsg :: ChatController -> IO JSONByteString
 chatRecvMsg ChatController {outputQ} = json <$> atomically (readTBQueue outputQ)
   where
-    json (corr, resp) = LB.unpack $ J.encode APIResponse {corr, resp}
+    json (corr, resp) = J.encode APIResponse {corr, resp}
 
-chatRecvMsgWait :: ChatController -> Int -> IO JSONString
+chatRecvMsgWait :: ChatController -> Int -> IO JSONByteString
 chatRecvMsgWait cc time = fromMaybe "" <$> timeout time (chatRecvMsg cc)
 
-chatParseMarkdown :: String -> JSONString
-chatParseMarkdown = LB.unpack . J.encode . ParsedMarkdown . parseMaybeMarkdownList . safeDecodeUtf8 . B.pack
+chatParseMarkdown :: ByteString -> JSONByteString
+chatParseMarkdown = J.encode . ParsedMarkdown . parseMaybeMarkdownList . safeDecodeUtf8
 
-chatParseServer :: String -> JSONString
-chatParseServer = LB.unpack . J.encode . toServerAddress . strDecode . B.pack
+chatParseServer :: ByteString -> JSONByteString
+chatParseServer = J.encode . toServerAddress . strDecode
   where
     toServerAddress :: Either String AProtoServerWithAuth -> ParsedServerAddress
     toServerAddress = \case
@@ -223,11 +221,11 @@ chatParseServer = LB.unpack . J.encode . toServerAddress . strDecode . B.pack
     enc :: StrEncoding a => a -> String
     enc = B.unpack . strEncode
 
-chatPasswordHash :: String -> String -> String
+chatPasswordHash :: ByteString -> ByteString -> ByteString
 chatPasswordHash pwd salt = either (const "") passwordHash salt'
   where
-    salt' = U.decode $ B.pack salt
-    passwordHash = B.unpack . U.encode . C.sha512Hash . (encodeUtf8 (T.pack pwd) <>)
+    salt' = U.decode salt
+    passwordHash = U.encode . C.sha512Hash . (pwd <>)
 
 data APIResponse = APIResponse {corr :: Maybe CorrId, resp :: ChatResponse}
   deriving (Generic)