diff --git a/simplexmq.cabal b/simplexmq.cabal index 519eaf366..06b7f61c8 100644 --- a/simplexmq.cabal +++ b/simplexmq.cabal @@ -73,7 +73,6 @@ library Simplex.FileTransfer.Chunks Simplex.FileTransfer.Client Simplex.FileTransfer.Client.Agent - Simplex.FileTransfer.Client.Main Simplex.FileTransfer.Client.Presets Simplex.FileTransfer.Crypto Simplex.FileTransfer.Description @@ -152,7 +151,6 @@ library Simplex.Messaging.Notifications.Types Simplex.Messaging.Parsers Simplex.Messaging.Protocol - Simplex.Messaging.Server.CLI Simplex.Messaging.Server.Expiration Simplex.Messaging.Server.QueueStore.QueueInfo Simplex.Messaging.ServiceScheme @@ -168,7 +166,6 @@ library Simplex.Messaging.Transport.HTTP2.Server Simplex.Messaging.Transport.KeepAlive Simplex.Messaging.Transport.Server - Simplex.Messaging.Transport.WebSockets Simplex.Messaging.Util Simplex.Messaging.Version Simplex.Messaging.Version.Internal @@ -179,6 +176,7 @@ library Simplex.RemoteControl.Types if !flag(client_library) exposed-modules: + Simplex.FileTransfer.Client.Main Simplex.FileTransfer.Server Simplex.FileTransfer.Server.Control Simplex.FileTransfer.Server.Env @@ -186,7 +184,17 @@ library Simplex.FileTransfer.Server.Stats Simplex.FileTransfer.Server.Store Simplex.FileTransfer.Server.StoreLog + Simplex.Messaging.Notifications.Server + Simplex.Messaging.Notifications.Server.Control + Simplex.Messaging.Notifications.Server.Env + Simplex.Messaging.Notifications.Server.Main + Simplex.Messaging.Notifications.Server.Push.APNS + Simplex.Messaging.Notifications.Server.Push.APNS.Internal + Simplex.Messaging.Notifications.Server.Stats + Simplex.Messaging.Notifications.Server.Store + Simplex.Messaging.Notifications.Server.StoreLog Simplex.Messaging.Server + Simplex.Messaging.Server.CLI Simplex.Messaging.Server.Control Simplex.Messaging.Server.Env.STM Simplex.Messaging.Server.Information @@ -201,15 +209,7 @@ library Simplex.Messaging.Server.Stats Simplex.Messaging.Server.StoreLog Simplex.Messaging.Server.StoreLog.Types - Simplex.Messaging.Notifications.Server - Simplex.Messaging.Notifications.Server.Control - Simplex.Messaging.Notifications.Server.Env - Simplex.Messaging.Notifications.Server.Main - Simplex.Messaging.Notifications.Server.Push.APNS - Simplex.Messaging.Notifications.Server.Push.APNS.Internal - Simplex.Messaging.Notifications.Server.Stats - Simplex.Messaging.Notifications.Server.Store - Simplex.Messaging.Notifications.Server.StoreLog + Simplex.Messaging.Transport.WebSockets other-modules: Paths_simplexmq hs-source-dirs: @@ -270,7 +270,6 @@ library , transformers ==0.6.* , unliftio ==0.2.* , unliftio-core ==0.2.* - , websockets ==0.12.* , yaml ==0.11.* , zstd ==0.1.3.* default-language: Haskell2010 @@ -280,6 +279,7 @@ library build-depends: case-insensitive ==1.2.* , hashable ==1.4.* + , websockets ==0.12.* if impl(ghc >= 9.6.2) build-depends: bytestring ==0.11.* diff --git a/src/Simplex/FileTransfer/Agent.hs b/src/Simplex/FileTransfer/Agent.hs index 2b6c1c5af..9506b465c 100644 --- a/src/Simplex/FileTransfer/Agent.hs +++ b/src/Simplex/FileTransfer/Agent.hs @@ -51,8 +51,7 @@ import Data.Text (Text) import Data.Time.Clock (getCurrentTime) import Data.Time.Format (defaultTimeLocale, formatTime) import Simplex.FileTransfer.Chunks (toKB) -import Simplex.FileTransfer.Client (XFTPChunkSpec (..)) -import Simplex.FileTransfer.Client.Main +import Simplex.FileTransfer.Client (XFTPChunkSpec (..), getChunkDigest, prepareChunkSizes, prepareChunkSpecs, singleChunkSize) import Simplex.FileTransfer.Crypto import Simplex.FileTransfer.Description import Simplex.FileTransfer.Protocol (FileParty (..), SFileParty (..)) diff --git a/src/Simplex/FileTransfer/Client.hs b/src/Simplex/FileTransfer/Client.hs index e5c66e764..de4da07f2 100644 --- a/src/Simplex/FileTransfer/Client.hs +++ b/src/Simplex/FileTransfer/Client.hs @@ -20,14 +20,18 @@ import Data.Bifunctor (first) import Data.ByteString.Builder (Builder, byteString) import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B +import qualified Data.ByteString.Lazy as LB import Data.Int (Int64) +import Data.List (foldl') import Data.List.NonEmpty (NonEmpty (..)) +import Data.Maybe (listToMaybe) import Data.Time.Clock (UTCTime) import Data.Word (Word32) import qualified Data.X509 as X import qualified Data.X509.Validation as XV import qualified Network.HTTP.Types as N import qualified Network.HTTP2.Client as H +import Simplex.FileTransfer.Chunks import Simplex.FileTransfer.Protocol import Simplex.FileTransfer.Transport import Simplex.Messaging.Client @@ -298,3 +302,41 @@ noFile HTTP2Body {bodyPart} a = case bodyPart of -- FACK :: FileCommand Recipient -- PING :: FileCommand Recipient + +singleChunkSize :: Int64 -> Maybe Word32 +singleChunkSize size' = + listToMaybe $ dropWhile (< chunkSize) serverChunkSizes + where + chunkSize = fromIntegral size' + +prepareChunkSizes :: Int64 -> [Word32] +prepareChunkSizes size' = prepareSizes size' + where + (smallSize, bigSize) + | size' > size34 chunkSize3 = (chunkSize2, chunkSize3) + | size' > size34 chunkSize2 = (chunkSize1, chunkSize2) + | otherwise = (chunkSize0, chunkSize1) + size34 sz = (fromIntegral sz * 3) `div` 4 + prepareSizes 0 = [] + prepareSizes size + | size >= fromIntegral bigSize = replicate (fromIntegral n1) bigSize <> prepareSizes remSz + | size > size34 bigSize = [bigSize] + | otherwise = replicate (fromIntegral n2') smallSize + where + (n1, remSz) = size `divMod` fromIntegral bigSize + n2' = let (n2, remSz2) = (size `divMod` fromIntegral smallSize) in if remSz2 == 0 then n2 else n2 + 1 + +prepareChunkSpecs :: FilePath -> [Word32] -> [XFTPChunkSpec] +prepareChunkSpecs filePath chunkSizes = reverse . snd $ foldl' addSpec (0, []) chunkSizes + where + addSpec :: (Int64, [XFTPChunkSpec]) -> Word32 -> (Int64, [XFTPChunkSpec]) + addSpec (chunkOffset, specs) sz = + let spec = XFTPChunkSpec {filePath, chunkOffset, chunkSize = sz} + in (chunkOffset + fromIntegral sz, spec : specs) + +getChunkDigest :: XFTPChunkSpec -> IO ByteString +getChunkDigest XFTPChunkSpec {filePath = chunkPath, chunkOffset, chunkSize} = + withFile chunkPath ReadMode $ \h -> do + hSeek h AbsoluteSeek $ fromIntegral chunkOffset + chunk <- LB.hGet h (fromIntegral chunkSize) + pure $! LC.sha256Hash chunk diff --git a/src/Simplex/FileTransfer/Client/Main.hs b/src/Simplex/FileTransfer/Client/Main.hs index 079392a1b..a330e21a7 100644 --- a/src/Simplex/FileTransfer/Client/Main.hs +++ b/src/Simplex/FileTransfer/Client/Main.hs @@ -19,11 +19,7 @@ module Simplex.FileTransfer.Client.Main singleChunkSize, prepareChunkSizes, prepareChunkSpecs, - maxFileSize, - maxFileSizeHard, - fileSizeLen, getChunkDigest, - SentRecipientReplica (..), ) where @@ -34,7 +30,6 @@ import Control.Monad.Trans.Except import Crypto.Random (ChaChaDRG) import qualified Data.Attoparsec.ByteString.Char8 as A import Data.Bifunctor (first) -import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as LB import Data.Char (toLower) @@ -45,7 +40,7 @@ import Data.List.NonEmpty (NonEmpty (..), nonEmpty) import qualified Data.List.NonEmpty as L import Data.Map.Strict (Map) import qualified Data.Map.Strict as M -import Data.Maybe (fromMaybe, listToMaybe) +import Data.Maybe (fromMaybe) import qualified Data.Text as T import Data.Word (Word32) import GHC.Records (HasField (getField)) @@ -80,20 +75,6 @@ import UnliftIO.Directory xftpClientVersion :: String xftpClientVersion = "1.0.1" --- | Soft limit for XFTP clients. Should be checked and reported to user. -maxFileSize :: Int64 -maxFileSize = gb 1 - -maxFileSizeStr :: String -maxFileSizeStr = B.unpack . strEncode $ FileSize maxFileSize - --- | Hard internal limit for XFTP agent after which it refuses to prepare chunks. -maxFileSizeHard :: Int64 -maxFileSizeHard = gb 5 - -fileSizeLen :: Int64 -fileSizeLen = 8 - newtype CLIError = CLIError String deriving (Eq, Show, Exception) @@ -231,16 +212,6 @@ data SentFileChunkReplica = SentFileChunkReplica } deriving (Show) -data SentRecipientReplica = SentRecipientReplica - { chunkNo :: Int, - server :: XFTPServer, - rcvNo :: Int, - replicaId :: ChunkReplicaId, - replicaKey :: C.APrivateAuthKey, - digest :: FileDigest, - chunkSize :: FileSize Word32 - } - logCfg :: LogConfig logCfg = LogConfig {lc_file = Nothing, lc_stderr = True} @@ -414,13 +385,6 @@ cliSendFileOpts SendOptions {filePath, outputDir, numRecipients, xftpServers, re B.writeFile fdSndPath $ strEncode fdSnd pure (fdRcvPaths, fdSndPath) -getChunkDigest :: XFTPChunkSpec -> IO ByteString -getChunkDigest XFTPChunkSpec {filePath = chunkPath, chunkOffset, chunkSize} = - withFile chunkPath ReadMode $ \h -> do - hSeek h AbsoluteSeek $ fromIntegral chunkOffset - chunk <- LB.hGet h (fromIntegral chunkSize) - pure $! LC.sha256Hash chunk - cliReceiveFile :: ReceiveOptions -> ExceptT CLIError IO () cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath, verbose, yes} = getFileDescription' fileDescription >>= receive @@ -536,37 +500,6 @@ getFileDescription' path = getFileDescription path >>= \case AVFD fd -> either (throwE . CLIError) pure $ checkParty fd -singleChunkSize :: Int64 -> Maybe Word32 -singleChunkSize size' = - listToMaybe $ dropWhile (< chunkSize) serverChunkSizes - where - chunkSize = fromIntegral size' - -prepareChunkSizes :: Int64 -> [Word32] -prepareChunkSizes size' = prepareSizes size' - where - (smallSize, bigSize) - | size' > size34 chunkSize3 = (chunkSize2, chunkSize3) - | size' > size34 chunkSize2 = (chunkSize1, chunkSize2) - | otherwise = (chunkSize0, chunkSize1) - size34 sz = (fromIntegral sz * 3) `div` 4 - prepareSizes 0 = [] - prepareSizes size - | size >= fromIntegral bigSize = replicate (fromIntegral n1) bigSize <> prepareSizes remSz - | size > size34 bigSize = [bigSize] - | otherwise = replicate (fromIntegral n2') smallSize - where - (n1, remSz) = size `divMod` fromIntegral bigSize - n2' = let (n2, remSz2) = (size `divMod` fromIntegral smallSize) in if remSz2 == 0 then n2 else n2 + 1 - -prepareChunkSpecs :: FilePath -> [Word32] -> [XFTPChunkSpec] -prepareChunkSpecs filePath chunkSizes = reverse . snd $ foldl' addSpec (0, []) chunkSizes - where - addSpec :: (Int64, [XFTPChunkSpec]) -> Word32 -> (Int64, [XFTPChunkSpec]) - addSpec (chunkOffset, specs) sz = - let spec = XFTPChunkSpec {filePath, chunkOffset, chunkSize = sz} - in (chunkOffset + fromIntegral sz, spec : specs) - getEncPath :: MonadIO m => Maybe FilePath -> String -> m FilePath getEncPath path name = (`uniqueCombine` (name <> ".encrypted")) =<< maybe (liftIO getCanonicalTemporaryDirectory) pure path diff --git a/src/Simplex/FileTransfer/Description.hs b/src/Simplex/FileTransfer/Description.hs index 8cb98fd32..865daf23d 100644 --- a/src/Simplex/FileTransfer/Description.hs +++ b/src/Simplex/FileTransfer/Description.hs @@ -37,6 +37,10 @@ module Simplex.FileTransfer.Description FileClientData, fileDescriptionURI, qrSizeLimit, + maxFileSize, + maxFileSizeStr, + maxFileSizeHard, + fileSizeLen, ) where @@ -266,6 +270,21 @@ instance StrEncoding FileDescriptionURI where qrSizeLimit :: Int qrSizeLimit = 1002 -- ~2 chunks in URLencoded YAML with some spare size for server hosts +-- | Soft limit for XFTP clients. Should be checked and reported to user. +maxFileSize :: Int64 +maxFileSize = gb 1 + +maxFileSizeStr :: String +maxFileSizeStr = B.unpack . strEncode $ FileSize maxFileSize + +-- | Hard internal limit for XFTP agent after which it refuses to prepare chunks. +maxFileSizeHard :: Int64 +maxFileSizeHard = gb 5 + +fileSizeLen :: Int64 +fileSizeLen = 8 + + instance (Integral a, Show a) => StrEncoding (FileSize a) where strEncode (FileSize b) | b' /= 0 = bshow b diff --git a/src/Simplex/FileTransfer/Types.hs b/src/Simplex/FileTransfer/Types.hs index 8569bdd12..571cf3748 100644 --- a/src/Simplex/FileTransfer/Types.hs +++ b/src/Simplex/FileTransfer/Types.hs @@ -246,6 +246,16 @@ data DeletedSndChunkReplica = DeletedSndChunkReplica } deriving (Show) +data SentRecipientReplica = SentRecipientReplica + { chunkNo :: Int, + server :: XFTPServer, + rcvNo :: Int, + replicaId :: ChunkReplicaId, + replicaKey :: C.APrivateAuthKey, + digest :: FileDigest, + chunkSize :: FileSize Word32 + } + data FileErrorType = -- | cannot proceed with download from not approved relays without proxy NOT_APPROVED diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs index 2ba7d9edf..9a030d4a5 100644 --- a/src/Simplex/Messaging/Client.hs +++ b/src/Simplex/Messaging/Client.hs @@ -145,7 +145,6 @@ import qualified Simplex.Messaging.TMap as TM import Simplex.Messaging.Transport import Simplex.Messaging.Transport.Client (SocksAuth (..), SocksProxyWithAuth (..), TransportClientConfig (..), TransportHost (..), defaultSMPPort, defaultTcpConnectTimeout, runTransportClient) import Simplex.Messaging.Transport.KeepAlive -import Simplex.Messaging.Transport.WebSockets (WS) import Simplex.Messaging.Util (bshow, diffToMicroseconds, ifM, liftEitherWith, raceAny_, threadDelay', tshow, whenM) import Simplex.Messaging.Version import System.Mem.Weak (Weak, deRefWeak) @@ -544,7 +543,6 @@ getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize "" -> case protocolTypeI @(ProtoType msg) of SPSMP | smpWebPort -> ("443", transport @TLS) _ -> defaultTransport cfg - "80" -> ("80", transport @WS) p -> (p, transport @TLS) client :: forall c. Transport c => TProxy c -> PClient v err msg -> TMVar (Either (ProtocolClientError err) (ProtocolClient v err msg)) -> c -> IO ()