mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-04-15 09:26:15 +00:00
12d1ada25e
* core: batch send stubs, comments * multiple events in ChatMessage and supporting types * Revert "multiple events in ChatMessage and supporting types" This reverts commit9b239b26ba. * schema, refactor group processing for batched messages * encoding, refactor processing * refactor code to work with updated schema * encoding, remove instances * wip * implement batching * batch introductions * wip * collect and send message history * missing new line * rename * test * rework to build history via chat items * refactor, tests * correctly set member version range, dont include deleted items * tests * fix disappearing messages * check number of errors * comment * check size in encodeChatMessage * fix - don't check msg size for binary * use builder * rename * rename * rework batching * lazy msg body * use withStoreBatch * refactor * reverse batches * comment * possibly fix builder for single msg * refactor batcher * refactor * dont repopulate msg_deliveries on down migration * EncodedChatMessage type * remove type * batcher tests * add tests * group history preference * test group link * fix tests * fix for random update * add test testImageFitsSingleBatch * refactor * rename function * refactor * mconcat * rename feature * catch error on each batch * refactor file inv retrieval * refactor gathering item forward events * refactor message batching * unite migrations * move files * refactor * Revert "unite migrations" This reverts commit0be7a3117a. * refactor splitFileDescr * improve tests * Revert "dont repopulate msg_deliveries on down migration" This reverts commit2944c1cc28. * fix down migration --------- Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
45 lines
1.4 KiB
Haskell
45 lines
1.4 KiB
Haskell
{-# LANGUAGE TupleSections #-}
|
|
|
|
module Simplex.Chat.Util (week, encryptFile, chunkSize, shuffle) where
|
|
|
|
import Control.Monad
|
|
import Control.Monad.Except
|
|
import Control.Monad.IO.Class
|
|
import qualified Data.ByteString.Lazy as LB
|
|
import Data.List (sortBy)
|
|
import Data.Ord (comparing)
|
|
import Data.Time (NominalDiffTime)
|
|
import Data.Word (Word16)
|
|
import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
|
|
import qualified Simplex.Messaging.Crypto.File as CF
|
|
import System.Random (randomRIO)
|
|
import UnliftIO.IO (IOMode (..), withFile)
|
|
|
|
week :: NominalDiffTime
|
|
week = 7 * 86400
|
|
|
|
encryptFile :: FilePath -> FilePath -> CryptoFileArgs -> ExceptT String IO ()
|
|
encryptFile fromPath toPath cfArgs = do
|
|
let toFile = CryptoFile toPath $ Just cfArgs
|
|
-- uncomment to test encryption error in runTestFileTransferEncrypted
|
|
-- throwError "test error"
|
|
withExceptT show $
|
|
withFile fromPath ReadMode $ \r -> CF.withFile toFile WriteMode $ \w -> do
|
|
encryptChunks r w
|
|
liftIO $ CF.hPutTag w
|
|
where
|
|
encryptChunks r w = do
|
|
ch <- liftIO $ LB.hGet r chunkSize
|
|
unless (LB.null ch) $ liftIO $ CF.hPut w ch
|
|
unless (LB.length ch < chunkSize) $ encryptChunks r w
|
|
|
|
chunkSize :: Num a => a
|
|
chunkSize = 65536
|
|
{-# INLINE chunkSize #-}
|
|
|
|
shuffle :: [a] -> IO [a]
|
|
shuffle xs = map snd . sortBy (comparing fst) <$> mapM (\x -> (,x) <$> random) xs
|
|
where
|
|
random :: IO Word16
|
|
random = randomRIO (0, 65535)
|