ntf server: better batching and logging (#780)

* ntf server: better batching and logging

* reduce batch delay for ntf server

* comments

* 5.1.3, ntf 1.4.2

* more logging

* more logging

* split large batches, more logging

* remove some logs
This commit is contained in:
Evgeny Poberezkin
2023-06-26 20:14:35 +01:00
committed by GitHub
parent 3a74558e84
commit 4a927d1ae2
19 changed files with 149 additions and 123 deletions
+4 -5
View File
@@ -38,9 +38,8 @@ import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as LB
import Data.Char (toLower)
import Data.Function (on)
import Data.Int (Int64)
import Data.List (foldl', groupBy, sortOn)
import Data.List (foldl', sortOn)
import Data.List.NonEmpty (NonEmpty (..), nonEmpty)
import qualified Data.List.NonEmpty as L
import Data.Map (Map)
@@ -66,7 +65,7 @@ import Simplex.Messaging.Encoding.String (StrEncoding (..))
import Simplex.Messaging.Parsers (parseAll)
import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), SenderId, SndPrivateSignKey, XFTPServer, XFTPServerWithAuth)
import Simplex.Messaging.Server.CLI (getCliCommand')
import Simplex.Messaging.Util (ifM, tshow, whenM)
import Simplex.Messaging.Util (groupAllOn, ifM, tshow, whenM)
import System.Exit (exitFailure)
import System.FilePath (splitFileName, (</>))
import System.IO.Temp (getCanonicalTemporaryDirectory)
@@ -316,7 +315,7 @@ cliSendFileOpts SendOptions {filePath, outputDir, numRecipients, xftpServers, re
let xftpSrvs = fromMaybe defaultXFTPServers (nonEmpty xftpServers)
srvs <- liftIO $ replicateM (length chunks) $ getXFTPServer gen xftpSrvs
let thd3 (_, _, x) = x
chunks' = groupBy ((==) `on` thd3) $ sortOn thd3 $ zip3 [1 ..] chunks srvs
chunks' = groupAllOn thd3 $ zip3 [1 ..] chunks srvs
-- TODO shuffle/unshuffle chunks
-- the reason we don't do pooled downloads here within one server is that http2 library doesn't handle cleint concurrency, even though
-- upload doesn't allow other requests within the same client until complete (but download does allow).
@@ -428,7 +427,7 @@ cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath,
liftIO $ printNoNewLine "Downloading file..."
downloadedChunks <- newTVarIO []
let srv FileChunk {replicas} = server (head replicas :: FileChunkReplica)
srvChunks = groupBy ((==) `on` srv) $ sortOn srv chunks
srvChunks = groupAllOn srv chunks
chunkPaths <- map snd . sortOn fst . concat <$> pooledForConcurrentlyN 16 srvChunks (mapM $ downloadFileChunk a encPath size downloadedChunks)
encDigest <- liftIO $ LC.sha512Hash <$> readChunks chunkPaths
when (encDigest /= unFileDigest digest) $ throwError $ CLIError "File digest mismatch"