dandri/simplexmq
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplexmq.git synced 2026-06-04 06:31:25 +00:00
Code Issues Packages Projects Releases Wiki Activity

5.4.0.0: use ghc 9.6.2 (#791)

Browse Source 
* Add 9.6 compat

* compile with GHC9.6.2: dependencies, imports, code

* refactor typeclasses

* refactor record dot

* update cabal version

* update github actions

* update direct-sqlcipher

* 5.4.0.0

* update cabal.project

---------

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
This commit is contained in:
Moritz Angermann
2023-08-25 03:22:02 +08:00
committed by GitHub
parent b001b748db
commit 002f36dde0
46 changed files with 261 additions and 245 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/FileTransfer/Client/Agent.hs
+2 -1
View File
@@ -8,6 +8,7 @@
module Simplex.FileTransfer.Client.Agent where
import Control.Logger.Simple (logInfo)
import Control.Monad
import Control.Monad.Except
import Data.Bifunctor (first)
import qualified Data.ByteString.Char8 as B
@@ -21,7 +22,7 @@ import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Protocol (ProtocolServer (..), XFTPServer)
import Simplex.Messaging.TMap (TMap)
import qualified Simplex.Messaging.TMap as TM
import Simplex.Messaging.Util (catchAll_, tryError)
import Simplex.Messaging.Util (catchAll_)
import UnliftIO
type XFTPClientVar = TMVar (Either XFTPClientAgentError XFTPClient)
src/Simplex/FileTransfer/Client/Main.hs
+6 -4
View File
@@ -5,10 +5,13 @@
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
module Simplex.FileTransfer.Client.Main
( SendOptions (..),
CLIError (..),
@@ -27,7 +30,6 @@ module Simplex.FileTransfer.Client.Main
)
where
import Control.Concurrent.STM (stateTVar)
import Control.Logger.Simple
import Control.Monad
import Control.Monad.Except
@@ -367,7 +369,7 @@ cliSendFileOpts SendOptions {filePath, outputDir, numRecipients, xftpServers, re
rcvChunks :: [[FileChunk]]
rcvChunks = map (sortChunks . M.elems) $ M.elems $ foldl' addRcvChunk M.empty rcvReplicas
sortChunks :: [FileChunk] -> [FileChunk]
sortChunks = map reverseReplicas . sortOn (chunkNo :: FileChunk -> Int)
sortChunks = map reverseReplicas . sortOn (\c -> c.chunkNo)
reverseReplicas ch@FileChunk {replicas} = (ch :: FileChunk) {replicas = reverse replicas}
addRcvChunk :: Map Int (Map Int FileChunk) -> SentRecipientReplica -> Map Int (Map Int FileChunk)
addRcvChunk m SentRecipientReplica {chunkNo, server, rcvNo, replicaId, replicaKey, digest, chunkSize} =
@@ -426,7 +428,7 @@ cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath,
a <- atomically $ newXFTPAgent defaultXFTPClientAgentConfig
liftIO $ printNoNewLine "Downloading file..."
downloadedChunks <- newTVarIO []
let srv FileChunk {replicas} = server (head replicas :: FileChunkReplica)
let srv FileChunk {replicas} = (head replicas).server
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
@@ -505,7 +507,7 @@ cliFileDescrInfo InfoOptions {fileDescription} = do
putStrLn $ "File download size: " <> strEnc size
putStrLn "File server(s):"
forM_ replicas $ \srvReplicas -> do
let srv = replicaServer $ head srvReplicas
let srv = (head srvReplicas).server
chSizes = map (\FileServerReplica {chunkSize = chSize_} -> unFileSize $ fromMaybe chunkSize chSize_) srvReplicas
putStrLn $ strEnc srv <> ": " <> strEnc (FileSize $ sum chSizes)
where