Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
26 changes: 13 additions & 13 deletions simplexmq.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand All @@ -179,14 +176,25 @@ 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
Simplex.FileTransfer.Server.Main
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
Expand All @@ -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:
Expand Down Expand Up @@ -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
Expand All @@ -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.*
Expand Down
3 changes: 1 addition & 2 deletions src/Simplex/FileTransfer/Agent.hs
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,7 @@
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}

Check warning on line 11 in src/Simplex/FileTransfer/Agent.hs

View workflow job for this annotation

GitHub Actions / build-ubuntu-20.04-8.10.7

unrecognised warning flag: -fno-warn-ambiguous-fields

module Simplex.FileTransfer.Agent
( startXFTPWorkers,
Expand Down Expand Up @@ -51,8 +51,7 @@
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 (..))
Expand Down
42 changes: 42 additions & 0 deletions src/Simplex/FileTransfer/Client.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
69 changes: 1 addition & 68 deletions src/Simplex/FileTransfer/Client/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,7 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}

Check warning on line 11 in src/Simplex/FileTransfer/Client/Main.hs

View workflow job for this annotation

GitHub Actions / build-ubuntu-20.04-8.10.7

unrecognised warning flag: -fno-warn-ambiguous-fields

module Simplex.FileTransfer.Client.Main
( SendOptions (..),
Expand All @@ -19,11 +19,7 @@
singleChunkSize,
prepareChunkSizes,
prepareChunkSpecs,
maxFileSize,
maxFileSizeHard,
fileSizeLen,
getChunkDigest,
SentRecipientReplica (..),
)
where

Expand All @@ -34,7 +30,6 @@
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)
Expand All @@ -45,7 +40,7 @@
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))
Expand Down Expand Up @@ -80,20 +75,6 @@
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)

Expand Down Expand Up @@ -231,16 +212,6 @@
}
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}

Expand Down Expand Up @@ -414,13 +385,6 @@
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
Expand Down Expand Up @@ -536,37 +500,6 @@
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

Expand Down
19 changes: 19 additions & 0 deletions src/Simplex/FileTransfer/Description.hs
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,7 @@
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}

Check warning on line 13 in src/Simplex/FileTransfer/Description.hs

View workflow job for this annotation

GitHub Actions / build-ubuntu-20.04-8.10.7

unrecognised warning flag: -fno-warn-ambiguous-fields

module Simplex.FileTransfer.Description
( FileDescription (..),
Expand All @@ -37,6 +37,10 @@
FileClientData,
fileDescriptionURI,
qrSizeLimit,
maxFileSize,
maxFileSizeStr,
maxFileSizeHard,
fileSizeLen,
)
where

Expand Down Expand Up @@ -266,6 +270,21 @@
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
Expand Down
10 changes: 10 additions & 0 deletions src/Simplex/FileTransfer/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 0 additions & 2 deletions src/Simplex/Messaging/Client.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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 ()
Expand Down
Loading