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/File.hs

@@ -27,11 +27,11 @@ import qualified Data.ByteString.Lazy as LB
 import qualified Data.ByteString.Lazy.Char8 as LB'
 import Data.Char (chr)
 import Data.Either (fromLeft)
-import Data.Word (Word8, Word32)
+import Data.Word (Word32, Word8)
 import Foreign.C
 import Foreign.Marshal.Alloc (mallocBytes)
 import Foreign.Ptr
-import Foreign.Storable (poke)
+import Foreign.Storable (poke, pokeByteOff)
 import GHC.Generics (Generic)
 import Simplex.Chat.Mobile.Shared
 import Simplex.Chat.Util (chunkSize, encryptFile)
@@ -54,7 +54,7 @@ cChatWriteFile cPath ptr len = do
   path <- peekCString cPath
   s <- getByteString ptr len
   r <- chatWriteFile path s
-  newCAString $ LB'.unpack $ J.encode r
+  newCStringFromLazyBS $ J.encode r
 
 chatWriteFile :: FilePath -> ByteString -> IO WriteFileResult
 chatWriteFile path s = do
@@ -78,12 +78,11 @@ cChatReadFile cPath cKey cNonce = do
   chatReadFile path key nonce >>= \case
     Left e -> castPtr <$> newCString (chr 1 : e)
     Right s -> do
-      let s' = LB.toStrict s
-          len = B.length s'
+      let len = fromIntegral $ LB.length s
       ptr <- mallocBytes $ len + 5
-      poke ptr 0
-      poke (ptr `plusPtr` 1) (fromIntegral len :: Word32)
-      putByteString (ptr `plusPtr` 5) s'
+      poke ptr (0 :: Word8)
+      pokeByteOff ptr 1 (fromIntegral len :: Word32)
+      putLazyByteString (ptr `plusPtr` 5) s
       pure ptr
 
 chatReadFile :: FilePath -> ByteString -> ByteString -> IO (Either String LB.ByteString)

src/Simplex/Chat/Mobile/Shared.hs

@@ -1,19 +1,48 @@
+{-# LANGUAGE LambdaCase #-}
+
 module Simplex.Chat.Mobile.Shared where
 
 import qualified Data.ByteString as B
-import Data.ByteString.Internal (ByteString (PS), memcpy)
+import Data.ByteString.Internal (ByteString (..), memcpy)
+import qualified Data.ByteString.Lazy as LB
+import qualified Data.ByteString.Lazy.Internal as LB
 import Foreign.C (CInt, CString)
-import Foreign (Ptr, Word8, newForeignPtr_, plusPtr)
-import Foreign.ForeignPtr.Unsafe
+import Foreign
 
 type CJSONString = CString
 
+type JSONByteString = LB.ByteString
+
 getByteString :: Ptr Word8 -> CInt -> IO ByteString
 getByteString ptr len = do
   fp <- newForeignPtr_ ptr
-  pure $ PS fp 0 $ fromIntegral len
+  pure $ BS fp $ fromIntegral len
+{-# INLINE getByteString #-}
 
 putByteString :: Ptr Word8 -> ByteString -> IO ()
-putByteString ptr bs@(PS fp offset _)  = do
-  let p = unsafeForeignPtrToPtr fp `plusPtr` offset
-  memcpy ptr p $ B.length bs
+putByteString ptr (BS fp len) =
+  withForeignPtr fp $ \p -> memcpy ptr p len
+{-# INLINE putByteString #-}
+
+putLazyByteString :: Ptr Word8 -> LB.ByteString -> IO ()
+putLazyByteString ptr = \case
+  LB.Empty -> pure ()
+  LB.Chunk ch s -> do
+    putByteString ptr ch
+    putLazyByteString (ptr `plusPtr` B.length ch) s
+
+newCStringFromBS :: ByteString -> IO CString
+newCStringFromBS s = do
+  let len = B.length s
+  buf <- mallocBytes (len + 1)
+  putByteString buf s
+  pokeByteOff buf len (0 :: Word8)
+  pure $ castPtr buf
+
+newCStringFromLazyBS :: LB.ByteString -> IO CString
+newCStringFromLazyBS s = do
+  let len = fromIntegral $ LB.length s
+  buf <- mallocBytes (len + 1)
+  putLazyByteString buf s
+  pokeByteOff buf len (0 :: Word8)
+  pure $ castPtr buf