send files to contacts (#94)

* schema for sending files

* send file "invitation"

* receive file "invitation"

* send/receive file flow (with stubs)

* update simplexmq

* send and receive the file (WIP - only the first chunk)

* sending and receiving file works (but it is slow)

* use correct terminal output for file sending/receiving

* improve file transfer, support cancellation

* command to show file transfer status and progress

* file transfer tests

* resume file transfer on restart (WIP)

* stabilize test of recipient cancelling file transfer

* trying to improve file transfer on restart

* update SMP block size and file chunk size

* acquire agent lock before chat lock to test whether it avoids deadlock

* fix resuming sending file on client restart

* manual message ACK (prevents losing messages between agent and chat client and stabilizes resuming file reception after restart)

* do NOT send file chunk after receiving it before it is appended to the file

* update file chunk size for SMP block size 8192 (set in smpDefaultConfig)

* save received files to ~/Downloads folder by default; create empty file when file is accepted

* keep file handle used to create empty file

* check message integrity

* fix trying to resume sending file when it was not yet accepted

* fix subscribing to pending connections on start

* update simplexmq (fixes smp-server syntax parser)

migrations/20210612_initial.sql

@@ -130,17 +130,68 @@ CREATE TABLE group_member_intros (
   UNIQUE (re_group_member_id, to_group_member_id)
 );
 
+CREATE TABLE files (
+  file_id INTEGER PRIMARY KEY,
+  contact_id INTEGER REFERENCES contacts ON DELETE RESTRICT,
+  group_id INTEGER REFERENCES groups ON DELETE RESTRICT,
+  file_name TEXT NOT NULL,
+  file_path TEXT,
+  file_size INTEGER NOT NULL,
+  chunk_size INTEGER NOT NULL,
+  created_at TEXT NOT NULL DEFAULT (datetime('now')),
+  user_id INTEGER NOT NULL REFERENCES users
+);
+
+CREATE TABLE snd_files (
+  file_id INTEGER NOT NULL REFERENCES files ON DELETE RESTRICT,
+  connection_id INTEGER NOT NULL REFERENCES connections ON DELETE RESTRICT,
+  file_status TEXT NOT NULL, -- new, accepted, connected, completed
+  group_member_id INTEGER REFERENCES group_members ON DELETE RESTRICT,
+  PRIMARY KEY (file_id, connection_id)
+) WITHOUT ROWID;
+
+CREATE TABLE rcv_files (
+  file_id INTEGER PRIMARY KEY REFERENCES files ON DELETE RESTRICT,
+  file_status TEXT NOT NULL, -- new, accepted, connected, completed
+  group_member_id INTEGER REFERENCES group_members ON DELETE RESTRICT,
+  file_queue_info BLOB
+);
+
+CREATE TABLE snd_file_chunks (
+  file_id INTEGER NOT NULL,
+  connection_id INTEGER NOT NULL,
+  chunk_number INTEGER NOT NULL,
+  chunk_agent_msg_id INTEGER,
+  chunk_sent INTEGER NOT NULL DEFAULT 0, -- 0 (sent to agent), 1 (sent to server)
+  FOREIGN KEY (file_id, connection_id) REFERENCES snd_files ON DELETE CASCADE,
+  PRIMARY KEY (file_id, connection_id, chunk_number)
+) WITHOUT ROWID;
+
+CREATE TABLE rcv_file_chunks (
+  file_id INTEGER NOT NULL REFERENCES rcv_files,
+  chunk_number INTEGER NOT NULL,
+  chunk_agent_msg_id INTEGER NOT NULL,
+  chunk_stored INTEGER NOT NULL DEFAULT 0, -- 0 (received), 1 (appended to file)
+  PRIMARY KEY (file_id, chunk_number)
+) WITHOUT ROWID;
+
 CREATE TABLE connections ( -- all SMP agent connections
   connection_id INTEGER PRIMARY KEY,
   agent_conn_id BLOB NOT NULL UNIQUE,
   conn_level INTEGER NOT NULL DEFAULT 0,
   via_contact INTEGER REFERENCES contacts (contact_id),
   conn_status TEXT NOT NULL,
-  conn_type TEXT NOT NULL, -- contact, member, member_direct
+  conn_type TEXT NOT NULL, -- contact, member, rcv_file, snd_file
   contact_id INTEGER REFERENCES contacts ON DELETE RESTRICT,
   group_member_id INTEGER REFERENCES group_members ON DELETE RESTRICT,
+  snd_file_id INTEGER,
+  rcv_file_id INTEGER REFERENCES rcv_files (file_id) ON DELETE RESTRICT,
   created_at TEXT NOT NULL DEFAULT (datetime('now')),
-  user_id INTEGER NOT NULL REFERENCES users
+  user_id INTEGER NOT NULL REFERENCES users,
+  FOREIGN KEY (snd_file_id, connection_id)
+    REFERENCES snd_files (file_id, connection_id)
+    ON DELETE RESTRICT
+    DEFERRABLE INITIALLY DEFERRED
 );
 
 CREATE TABLE events ( -- messages received by the agent, append only

src/Simplex/Chat.hs

@@ -12,7 +12,8 @@
 
 module Simplex.Chat where
 
-import Control.Applicative ((<|>))
+import Control.Applicative (optional, (<|>))
+import Control.Concurrent.STM (stateTVar)
 import Control.Logger.Simple
 import Control.Monad.Except
 import Control.Monad.IO.Unlift
@@ -24,12 +25,14 @@ import Data.Bifunctor (first)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Functor (($>))
+import Data.Int (Int64)
 import Data.List (find)
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as M
 import Data.Maybe (isJust, mapMaybe)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
-import Numeric.Natural
 import Simplex.Chat.Controller
 import Simplex.Chat.Help
 import Simplex.Chat.Input
@@ -40,18 +43,24 @@ import Simplex.Chat.Store
 import Simplex.Chat.Styled (plain)
 import Simplex.Chat.Terminal
 import Simplex.Chat.Types
+import Simplex.Chat.Util (ifM, unlessM)
 import Simplex.Chat.View
 import Simplex.Messaging.Agent
 import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), defaultAgentConfig)
 import Simplex.Messaging.Agent.Protocol
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Parsers (parseAll)
-import Simplex.Messaging.Util (raceAny_)
+import qualified Simplex.Messaging.Protocol as SMP
+import Simplex.Messaging.Util (bshow, raceAny_)
 import System.Exit (exitFailure, exitSuccess)
-import System.IO (hFlush, stdout)
+import System.FilePath (combine, splitExtensions, takeFileName)
+import System.IO (Handle, IOMode (..), SeekMode (..), hFlush, openFile, stdout)
 import Text.Read (readMaybe)
 import UnliftIO.Async (race_)
+import UnliftIO.Concurrent (forkIO, threadDelay)
+import UnliftIO.Directory (doesDirectoryExist, doesFileExist, getFileSize, getHomeDirectory, getTemporaryDirectory)
 import qualified UnliftIO.Exception as E
+import UnliftIO.IO (hClose, hSeek, hTell)
 import UnliftIO.STM
 
 data ChatCommand
@@ -70,17 +79,16 @@ data ChatCommand
   | DeleteGroup GroupName
   | ListMembers GroupName
   | SendGroupMessage GroupName ByteString
+  | SendFile ContactName FilePath
+  | SendGroupFile GroupName FilePath
+  | ReceiveFile Int64 (Maybe FilePath)
+  | CancelFile Int64
+  | FileStatus Int64
   | UpdateProfile Profile
   | ShowProfile
   | QuitChat
   deriving (Show)
 
-data ChatConfig = ChatConfig
-  { agentConfig :: AgentConfig,
-    dbPoolSize :: Int,
-    tbqSize :: Natural
-  }
-
 defaultChatConfig :: ChatConfig
 defaultChatConfig =
   ChatConfig
@@ -92,7 +100,8 @@ defaultChatConfig =
             dbPoolSize = 1
           },
       dbPoolSize = 1,
-      tbqSize = 16
+      tbqSize = 16,
+      fileChunkSize = 7050
     }
 
 logCfg :: LogConfig
@@ -107,7 +116,7 @@ simplexChat cfg opts t =
     >>= runSimplexChat
 
 newChatController :: WithTerminal t => ChatConfig -> ChatOpts -> t -> (Notification -> IO ()) -> IO ChatController
-newChatController ChatConfig {agentConfig = cfg, dbPoolSize, tbqSize} ChatOpts {dbFile, smpServers} t sendNotification = do
+newChatController config@ChatConfig {agentConfig = cfg, dbPoolSize, tbqSize} ChatOpts {dbFile, smpServers} t sendNotification = do
   chatStore <- createStore (dbFile <> ".chat.db") dbPoolSize
   currentUser <- newTVarIO =<< getCreateActiveUser chatStore
   chatTerminal <- newChatTerminal t
@@ -116,6 +125,8 @@ newChatController ChatConfig {agentConfig = cfg, dbPoolSize, tbqSize} ChatOpts {
   inputQ <- newTBQueueIO tbqSize
   notifyQ <- newTBQueueIO tbqSize
   chatLock <- newTMVarIO ()
+  sndFiles <- newTVarIO M.empty
+  rcvFiles <- newTVarIO M.empty
   pure ChatController {..}
 
 runSimplexChat :: ChatController -> IO ()
@@ -139,6 +150,7 @@ inputSubscriber :: (MonadUnliftIO m, MonadReader ChatController m) => m ()
 inputSubscriber = do
   q <- asks inputQ
   l <- asks chatLock
+  a <- asks smpAgent
   forever $
     atomically (readTBQueue q) >>= \case
       InputControl _ -> pure ()
@@ -151,10 +163,10 @@ inputSubscriber = do
               SendGroupMessage g msg -> showSentGroupMessage g msg
               _ -> printToView [plain s]
             user <- readTVarIO =<< asks currentUser
-            withLock l . void . runExceptT $
+            withAgentLock a . withLock l . void . runExceptT $
               processChatCommand user cmd `catchError` showChatError
 
-processChatCommand :: ChatMonad m => User -> ChatCommand -> m ()
+processChatCommand :: forall m. ChatMonad m => User -> ChatCommand -> m ()
 processChatCommand user@User {userId, profile} = \case
   ChatHelp -> printToView chatHelpInfo
   MarkdownHelp -> printToView markdownInfo
@@ -247,6 +259,36 @@ processChatCommand user@User {userId, profile} = \case
     let msgEvent = XMsgNew $ MsgContent MTText [] [MsgContentBody {contentType = SimplexContentType XCText, contentData = msg}]
     sendGroupMessage members msgEvent
     setActive $ ActiveG gName
+  SendFile cName f -> do
+    unlessM (doesFileExist f) . chatError $ CEFileNotFound f
+    contact@Contact {contactId} <- withStore $ \st -> getContact st userId cName
+    (agentConnId, fileQInfo) <- withAgent createConnection
+    fileSize <- getFileSize f
+    let fileInv = FileInvitation {fileName = takeFileName f, fileSize, fileQInfo}
+    chSize <- asks $ fileChunkSize . config
+    ft <- withStore $ \st -> createSndFileTransfer st userId contactId f fileInv agentConnId chSize
+    sendDirectMessage (contactConnId contact) $ XFile fileInv
+    showSentFileInvitation cName ft
+    setActive $ ActiveC cName
+  SendGroupFile _gName _file -> pure ()
+  ReceiveFile fileId filePath_ -> do
+    RcvFileTransfer {fileInvitation = FileInvitation {fileName, fileQInfo}, fileStatus} <- withStore $ \st -> getRcvFileTransfer st userId fileId
+    unless (fileStatus == RFSNew) . chatError $ CEFileAlreadyReceiving fileName
+    agentConnId <- withAgent $ \a -> joinConnection a fileQInfo . directMessage $ XFileAcpt fileName
+    filePath <- getRcvFilePath fileId filePath_ fileName
+    withStore $ \st -> acceptRcvFileTransfer st userId fileId agentConnId filePath
+    -- TODO include file sender in the message
+    showRcvFileAccepted fileId filePath
+  CancelFile fileId ->
+    withStore (\st -> getFileTransfer st userId fileId) >>= \case
+      FTSnd fts -> do
+        mapM_ cancelSndFileTransfer fts
+        showSndFileCancelled fileId
+      FTRcv ft -> do
+        cancelRcvFileTransfer ft
+        showRcvFileCancelled fileId
+  FileStatus fileId ->
+    withStore (\st -> getFileTransferProgress st userId fileId) >>= showFileTransferStatus
   UpdateProfile p -> unless (p == profile) $ do
     user' <- withStore $ \st -> updateUserProfile st user p
     asks currentUser >>= atomically . (`writeTVar` user')
@@ -260,6 +302,37 @@ processChatCommand user@User {userId, profile} = \case
     contactMember Contact {contactId} =
       find $ \GroupMember {memberContactId = cId, memberStatus = s} ->
         cId == Just contactId && s /= GSMemRemoved && s /= GSMemLeft
+    getRcvFilePath :: Int64 -> Maybe FilePath -> String -> m FilePath
+    getRcvFilePath fileId filePath fileName = case filePath of
+      Nothing -> do
+        dir <- (`combine` "Downloads") <$> getHomeDirectory
+        ifM (doesDirectoryExist dir) (pure dir) getTemporaryDirectory
+          >>= (`uniqueCombine` fileName)
+          >>= createEmptyFile
+      Just fPath ->
+        ifM
+          (doesDirectoryExist fPath)
+          (fPath `uniqueCombine` fileName >>= createEmptyFile)
+          $ ifM
+            (doesFileExist fPath)
+            (chatError $ CEFileAlreadyExists fPath)
+            (createEmptyFile fPath)
+      where
+        createEmptyFile :: FilePath -> m FilePath
+        createEmptyFile fPath = emptyFile fPath `E.catch` (chatError . CEFileWrite fPath)
+        emptyFile :: FilePath -> m FilePath
+        emptyFile fPath = do
+          h <- getFileHandle fileId fPath rcvFiles AppendMode
+          liftIO $ B.hPut h "" >> hFlush h
+          pure fPath
+    uniqueCombine :: FilePath -> String -> m FilePath
+    uniqueCombine filePath fileName = tryCombine (0 :: Int)
+      where
+        tryCombine n =
+          let (name, ext) = splitExtensions fileName
+              suffix = if n == 0 then "" else "_" <> show n
+              f = filePath `combine` (name <> suffix <> ext)
+           in ifM (doesFileExist f) (tryCombine $ n + 1) (pure f)
 
 agentSubscriber :: (MonadUnliftIO m, MonadReader ChatController m) => m ()
 agentSubscriber = do
@@ -269,15 +342,15 @@ agentSubscriber = do
   forever $ do
     (_, connId, msg) <- atomically $ readTBQueue q
     user <- readTVarIO =<< asks currentUser
-    -- TODO handle errors properly
     withLock l . void . runExceptT $
-      processAgentMessage user connId msg `catchError` (liftIO . print)
+      processAgentMessage user connId msg `catchError` showChatError
 
 subscribeUserConnections :: (MonadUnliftIO m, MonadReader ChatController m) => m ()
 subscribeUserConnections = void . runExceptT $ do
   user <- readTVarIO =<< asks currentUser
   subscribeContacts user
   subscribeGroups user
+  subscribeFiles user
   subscribePendingConnections user
   where
     subscribeContacts user = do
@@ -297,6 +370,27 @@ subscribeUserConnections = void . runExceptT $ do
             forM_ connectedMembers $ \(GroupMember {localDisplayName = c}, cId) ->
               subscribe cId `catchError` showMemberSubError g c
             showGroupSubscribed g
+    subscribeFiles user = do
+      withStore (`getLiveSndFileTransfers` user) >>= mapM_ subscribeSndFile
+      withStore (`getLiveRcvFileTransfers` user) >>= mapM_ subscribeRcvFile
+      where
+        subscribeSndFile ft@SndFileTransfer {fileId, fileStatus, agentConnId} = do
+          subscribe agentConnId `catchError` showSndFileSubError ft
+          void . forkIO $ do
+            threadDelay 1000000
+            l <- asks chatLock
+            a <- asks smpAgent
+            unless (fileStatus == FSNew) . unlessM (isFileActive fileId sndFiles) $
+              withAgentLock a . withLock l $
+                sendFileChunk ft
+        subscribeRcvFile ft@RcvFileTransfer {fileStatus} =
+          case fileStatus of
+            RFSAccepted fInfo -> resume fInfo
+            RFSConnected fInfo -> resume fInfo
+            _ -> pure ()
+          where
+            resume RcvFileInfo {agentConnId} =
+              subscribe agentConnId `catchError` showRcvFileSubError ft
     subscribePendingConnections user = do
       connections <- withStore (`getPendingConnections` user)
       forM_ connections $ \Connection {agentConnId} ->
@@ -304,7 +398,7 @@ subscribeUserConnections = void . runExceptT $ do
     subscribe cId = withAgent (`subscribeConnection` cId)
 
 processAgentMessage :: forall m. ChatMonad m => User -> ConnId -> ACommand 'Agent -> m ()
-processAgentMessage user@User {userId, profile} agentConnId agentMessage = unless (sent agentMessage) $ do
+processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
   chatDirection <- withStore $ \st -> getConnectionChatDirection st user agentConnId
   forM_ (agentMsgConnStatus agentMessage) $ \status ->
     withStore $ \st -> updateConnectionStatus st (fromConnection chatDirection) status
@@ -313,11 +407,11 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = unles
       processDirectMessage agentMessage conn maybeContact
     ReceivedGroupMessage conn gName m ->
       processGroupMessage agentMessage conn gName m
+    RcvFileConnection conn ft ->
+      processRcvFileConn agentMessage conn ft
+    SndFileConnection conn ft ->
+      processSndFileConn agentMessage conn ft
   where
-    sent :: ACommand 'Agent -> Bool
-    sent SENT {} = True
-    sent _ = False
-
     isMember :: MemberId -> Group -> Bool
     isMember memId Group {membership, members} =
       memberId membership == memId || isJust (find ((== memId) . memberId) members)
@@ -343,12 +437,15 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = unles
           acceptAgentConnection conn confId $ XInfo profile
         INFO connInfo ->
           saveConnInfo conn connInfo
+        MSG meta _ ->
+          withAckMessage agentConnId meta $ pure ()
         _ -> pure ()
       Just ct@Contact {localDisplayName = c} -> case agentMsg of
-        MSG meta msgBody -> do
+        MSG meta msgBody -> withAckMessage agentConnId meta $ do
           ChatMessage {chatMsgEvent} <- liftEither $ parseChatMessage msgBody
           case chatMsgEvent of
             XMsgNew (MsgContent MTText [] body) -> newTextMessage c meta $ find (isSimplexContentType XCText) body
+            XFile fInv -> processFileInvitation ct fInv
             XInfo p -> xInfo ct p
             XGrpInv gInv -> processGroupInvitation ct gInv
             XInfoProbe probe -> xInfoProbe ct probe
@@ -461,7 +558,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = unles
                 when (contactIsReady ct) $ do
                   notifyMemberConnected gName m
                   when (memberCategory m == GCPreMember) $ probeMatchingContacts ct
-      MSG meta msgBody -> do
+      MSG meta msgBody -> withAckMessage agentConnId meta $ do
         ChatMessage {chatMsgEvent} <- liftEither $ parseChatMessage msgBody
         case chatMsgEvent of
           XMsgNew (MsgContent MTText [] body) ->
@@ -476,6 +573,81 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = unles
           _ -> messageError $ "unsupported message: " <> T.pack (show chatMsgEvent)
       _ -> pure ()
 
+    processSndFileConn :: ACommand 'Agent -> Connection -> SndFileTransfer -> m ()
+    processSndFileConn agentMsg conn ft@SndFileTransfer {fileId, fileName, fileStatus} =
+      case agentMsg of
+        REQ confId connInfo -> do
+          ChatMessage {chatMsgEvent} <- liftEither $ parseChatMessage connInfo
+          case chatMsgEvent of
+            XFileAcpt name
+              | name == fileName -> do
+                withStore $ \st -> updateSndFileStatus st ft FSAccepted
+                acceptAgentConnection conn confId XOk
+              | otherwise -> messageError "x.file.acpt: fileName is different from expected"
+            _ -> messageError "REQ from file connection must have x.file.acpt"
+        CON -> do
+          withStore $ \st -> updateSndFileStatus st ft FSConnected
+          showSndFileStart fileId
+          sendFileChunk ft
+        SENT msgId -> do
+          withStore $ \st -> updateSndFileChunkSent st ft msgId
+          unless (fileStatus == FSCancelled) $ sendFileChunk ft
+        MERR _ err -> do
+          cancelSndFileTransfer ft
+          case err of
+            SMP SMP.AUTH -> unless (fileStatus == FSCancelled) $ showSndFileRcvCancelled fileId
+            _ -> chatError $ CEFileSend fileId err
+        MSG meta _ ->
+          withAckMessage agentConnId meta $ pure ()
+        _ -> pure ()
+
+    processRcvFileConn :: ACommand 'Agent -> Connection -> RcvFileTransfer -> m ()
+    processRcvFileConn agentMsg _conn ft@RcvFileTransfer {fileId, chunkSize} =
+      case agentMsg of
+        CON -> do
+          withStore $ \st -> updateRcvFileStatus st ft FSConnected
+          showRcvFileStart fileId
+        MSG meta@MsgMeta {recipient = (msgId, _), integrity} msgBody -> withAckMessage agentConnId meta $ do
+          parseFileChunk msgBody >>= \case
+            (0, _) -> do
+              cancelRcvFileTransfer ft
+              showRcvFileSndCancelled fileId
+            (chunkNo, chunk) -> do
+              case integrity of
+                MsgOk -> pure ()
+                MsgError MsgDuplicate -> pure () -- TODO remove once agent removes duplicates
+                MsgError e ->
+                  badRcvFileChunk ft $ "invalid file chunk number " <> show chunkNo <> ": " <> show e
+              withStore (\st -> createRcvFileChunk st ft chunkNo msgId) >>= \case
+                RcvChunkOk ->
+                  if B.length chunk /= fromInteger chunkSize
+                    then badRcvFileChunk ft "incorrect chunk size"
+                    else appendFileChunk ft chunkNo chunk
+                RcvChunkFinal ->
+                  if B.length chunk > fromInteger chunkSize
+                    then badRcvFileChunk ft "incorrect chunk size"
+                    else do
+                      appendFileChunk ft chunkNo chunk
+                      withStore $ \st -> updateRcvFileStatus st ft FSComplete
+                      showRcvFileComplete fileId
+                      closeFileHandle fileId rcvFiles
+                      withAgent (`deleteConnection` agentConnId)
+                RcvChunkDuplicate -> pure ()
+                RcvChunkError -> badRcvFileChunk ft $ "incorrect chunk number " <> show chunkNo
+        _ -> pure ()
+
+    withAckMessage :: ConnId -> MsgMeta -> m () -> m ()
+    withAckMessage cId MsgMeta {recipient = (msgId, _)} action =
+      action `E.finally` withAgent (\a -> ackMessage a cId msgId `catchError` \_ -> pure ())
+
+    badRcvFileChunk :: RcvFileTransfer -> String -> m ()
+    badRcvFileChunk ft@RcvFileTransfer {fileStatus} err =
+      case fileStatus of
+        RFSCancelled _ -> pure ()
+        _ -> do
+          cancelRcvFileTransfer ft
+          chatError $ CEFileRcvChunk err
+
     notifyMemberConnected :: GroupName -> GroupMember -> m ()
     notifyMemberConnected gName m@GroupMember {localDisplayName} = do
       showConnectedToGroupMember gName m
@@ -496,10 +668,10 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = unles
           withStore $ \st -> createSentProbeHash st userId probeId c
 
     messageWarning :: Text -> m ()
-    messageWarning = liftIO . print
+    messageWarning = showMessageError "warning"
 
     messageError :: Text -> m ()
-    messageError = liftIO . print
+    messageError = showMessageError "error"
 
     newTextMessage :: ContactName -> MsgMeta -> Maybe MsgContentBody -> m ()
     newTextMessage c meta = \case
@@ -519,6 +691,14 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = unles
         setActive $ ActiveG gName
       _ -> messageError "x.msg.new: no expected message body"
 
+    processFileInvitation :: Contact -> FileInvitation -> m ()
+    processFileInvitation Contact {contactId, localDisplayName = c} fInv = do
+      -- TODO chunk size has to be sent as part of invitation
+      chSize <- asks $ fileChunkSize . config
+      ft <- withStore $ \st -> createRcvFileTransfer st userId contactId fInv chSize
+      showReceivedFileInvitation c ft
+      setActive $ ActiveC c
+
     processGroupInvitation :: Contact -> GroupInvitation -> m ()
     processGroupInvitation ct@Contact {localDisplayName} inv@(GroupInvitation (fromMemId, fromRole) (memId, memRole) _ _) = do
       when (fromRole < GRAdmin || fromRole < memRole) $ chatError (CEGroupContactRole localDisplayName)
@@ -662,7 +842,96 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = unles
       mapM_ deleteMemberConnection ms
       showGroupDeleted gName m
 
-chatError :: ChatMonad m => ChatErrorType -> m ()
+sendFileChunk :: ChatMonad m => SndFileTransfer -> m ()
+sendFileChunk ft@SndFileTransfer {fileId, fileStatus, agentConnId} =
+  unless (fileStatus == FSComplete || fileStatus == FSCancelled) $
+    withStore (`createSndFileChunk` ft) >>= \case
+      Just chunkNo -> sendFileChunkNo ft chunkNo
+      Nothing -> do
+        withStore $ \st -> updateSndFileStatus st ft FSComplete
+        showSndFileComplete fileId
+        closeFileHandle fileId sndFiles
+        withAgent (`deleteConnection` agentConnId)
+
+sendFileChunkNo :: ChatMonad m => SndFileTransfer -> Integer -> m ()
+sendFileChunkNo ft@SndFileTransfer {agentConnId} chunkNo = do
+  bytes <- readFileChunk ft chunkNo
+  msgId <- withAgent $ \a -> sendMessage a agentConnId $ serializeFileChunk chunkNo bytes
+  withStore $ \st -> updateSndFileChunkMsg st ft chunkNo msgId
+
+readFileChunk :: ChatMonad m => SndFileTransfer -> Integer -> m ByteString
+readFileChunk SndFileTransfer {fileId, filePath, chunkSize} chunkNo =
+  read_ `E.catch` (chatError . CEFileRead filePath)
+  where
+    read_ = do
+      h <- getFileHandle fileId filePath sndFiles ReadMode
+      pos <- hTell h
+      let pos' = (chunkNo - 1) * chunkSize
+      when (pos /= pos') $ hSeek h AbsoluteSeek pos'
+      liftIO . B.hGet h $ fromInteger chunkSize
+
+parseFileChunk :: ChatMonad m => ByteString -> m (Integer, ByteString)
+parseFileChunk msg =
+  liftEither . first (ChatError . CEFileRcvChunk) $
+    parseAll ((,) <$> A.decimal <* A.space <*> A.takeByteString) msg
+
+serializeFileChunk :: Integer -> ByteString -> ByteString
+serializeFileChunk chunkNo bytes = bshow chunkNo <> " " <> bytes
+
+appendFileChunk :: ChatMonad m => RcvFileTransfer -> Integer -> ByteString -> m ()
+appendFileChunk ft@RcvFileTransfer {fileId, fileStatus} chunkNo chunk =
+  case fileStatus of
+    RFSConnected RcvFileInfo {filePath} -> append_ filePath
+    RFSCancelled _ -> pure ()
+    _ -> chatError $ CEFileInternal "receiving file transfer not in progress"
+  where
+    append_ fPath = do
+      h <- getFileHandle fileId fPath rcvFiles AppendMode
+      E.try (liftIO $ B.hPut h chunk >> hFlush h) >>= \case
+        Left e -> chatError $ CEFileWrite fPath e
+        Right () -> withStore $ \st -> updatedRcvFileChunkStored st ft chunkNo
+
+getFileHandle :: ChatMonad m => Int64 -> FilePath -> (ChatController -> TVar (Map Int64 Handle)) -> IOMode -> m Handle
+getFileHandle fileId filePath files ioMode = do
+  fs <- asks files
+  h_ <- M.lookup fileId <$> readTVarIO fs
+  maybe (newHandle fs) pure h_
+  where
+    newHandle fs = do
+      -- TODO handle errors
+      h <- liftIO (openFile filePath ioMode)
+      atomically . modifyTVar fs $ M.insert fileId h
+      pure h
+
+isFileActive :: ChatMonad m => Int64 -> (ChatController -> TVar (Map Int64 Handle)) -> m Bool
+isFileActive fileId files = do
+  fs <- asks files
+  isJust . M.lookup fileId <$> readTVarIO fs
+
+cancelRcvFileTransfer :: ChatMonad m => RcvFileTransfer -> m ()
+cancelRcvFileTransfer ft@RcvFileTransfer {fileId, fileStatus} = do
+  closeFileHandle fileId rcvFiles
+  withStore $ \st -> updateRcvFileStatus st ft FSCancelled
+  case fileStatus of
+    RFSAccepted RcvFileInfo {agentConnId} -> withAgent (`suspendConnection` agentConnId)
+    RFSConnected RcvFileInfo {agentConnId} -> withAgent (`suspendConnection` agentConnId)
+    _ -> pure ()
+
+cancelSndFileTransfer :: ChatMonad m => SndFileTransfer -> m ()
+cancelSndFileTransfer ft@SndFileTransfer {agentConnId, fileStatus} =
+  unless (fileStatus == FSCancelled || fileStatus == FSComplete) $ do
+    withStore $ \st -> updateSndFileStatus st ft FSCancelled
+    withAgent $ \a -> do
+      void $ sendMessage a agentConnId "0 "
+      suspendConnection a agentConnId
+
+closeFileHandle :: ChatMonad m => Int64 -> (ChatController -> TVar (Map Int64 Handle)) -> m ()
+closeFileHandle fileId files = do
+  fs <- asks files
+  h_ <- atomically . stateTVar fs $ \m -> (M.lookup fileId m, M.delete fileId m)
+  mapM_ hClose h_ `E.catch` \(_ :: E.SomeException) -> pure ()
+
+chatError :: ChatMonad m => ChatErrorType -> m a
 chatError = throwError . ChatError
 
 deleteMemberConnection :: ChatMonad m => GroupMember -> m ()
@@ -790,6 +1059,11 @@ chatCommandP =
     <|> ("/connect" <|> "/c") $> AddContact
     <|> ("/delete @" <|> "/delete " <|> "/d @" <|> "/d ") *> (DeleteContact <$> displayName)
     <|> A.char '@' *> (SendMessage <$> displayName <*> (A.space *> A.takeByteString))
+    <|> ("/file #" <|> "/f #") *> (SendGroupFile <$> displayName <* A.space <*> filePath)
+    <|> ("/file @" <|> "/file " <|> "/f @" <|> "/f ") *> (SendFile <$> displayName <* A.space <*> filePath)
+    <|> ("/file_receive " <|> "/fr ") *> (ReceiveFile <$> A.decimal <*> optional (A.space *> filePath))
+    <|> ("/file_cancel " <|> "/fc ") *> (CancelFile <$> A.decimal)
+    <|> ("/file_status " <|> "/fs ") *> (FileStatus <$> A.decimal)
     <|> ("/markdown" <|> "/m") $> MarkdownHelp
     <|> ("/profile " <|> "/p ") *> (UpdateProfile <$> userProfile)
     <|> ("/profile" <|> "/p") $> ShowProfile
@@ -808,6 +1082,7 @@ chatCommandP =
     fullNameP name = do
       n <- (A.space *> A.takeByteString) <|> pure ""
       pure $ if B.null n then name else safeDecodeUtf8 n
+    filePath = T.unpack . safeDecodeUtf8 <$> A.takeByteString
     memberRole =
       (" owner" $> GROwner)
         <|> (" admin" $> GRAdmin)

src/Simplex/Chat/Controller.hs

@@ -11,15 +11,27 @@ import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Reader
 import Crypto.Random (ChaChaDRG)
+import Data.Int (Int64)
+import Data.Map.Strict (Map)
+import Numeric.Natural
 import Simplex.Chat.Notification
 import Simplex.Chat.Store (StoreError)
 import Simplex.Chat.Terminal
 import Simplex.Chat.Types
 import Simplex.Messaging.Agent (AgentClient)
+import Simplex.Messaging.Agent.Env.SQLite (AgentConfig)
 import Simplex.Messaging.Agent.Protocol (AgentErrorType)
 import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore)
+import System.IO (Handle)
 import UnliftIO.STM
 
+data ChatConfig = ChatConfig
+  { agentConfig :: AgentConfig,
+    dbPoolSize :: Int,
+    tbqSize :: Natural,
+    fileChunkSize :: Integer
+  }
+
 data ChatController = ChatController
   { currentUser :: TVar User,
     smpAgent :: AgentClient,
@@ -29,7 +41,10 @@ data ChatController = ChatController
     inputQ :: TBQueue InputEvent,
     notifyQ :: TBQueue Notification,
     sendNotification :: Notification -> IO (),
-    chatLock :: TMVar ()
+    chatLock :: TMVar (),
+    sndFiles :: TVar (Map Int64 Handle),
+    rcvFiles :: TVar (Map Int64 Handle),
+    config :: ChatConfig
   }
 
 data InputEvent = InputCommand String | InputControl Char
@@ -51,6 +66,14 @@ data ChatErrorType
   | CEGroupMemberUserRemoved
   | CEGroupMemberNotFound ContactName
   | CEGroupInternal String
+  | CEFileNotFound String
+  | CEFileAlreadyReceiving String
+  | CEFileAlreadyExists FilePath
+  | CEFileRead FilePath SomeException
+  | CEFileWrite FilePath SomeException
+  | CEFileSend Int64 AgentErrorType
+  | CEFileRcvChunk String
+  | CEFileInternal String
   deriving (Show, Exception)
 
 type ChatMonad m = (MonadUnliftIO m, MonadReader ChatController m, MonadError ChatError m)

src/Simplex/Chat/Protocol.hs

@@ -23,7 +23,10 @@ import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Int (Int64)
 import Data.List (find)
 import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Text.Encoding (encodeUtf8)
 import Simplex.Chat.Types
+import Simplex.Chat.Util (safeDecodeUtf8)
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Parsers (parseAll)
 import Simplex.Messaging.Util (bshow)
@@ -33,6 +36,8 @@ data ChatDirection (p :: AParty) where
   SentDirectMessage :: Contact -> ChatDirection 'Client
   ReceivedGroupMessage :: Connection -> GroupName -> GroupMember -> ChatDirection 'Agent
   SentGroupMessage :: GroupName -> ChatDirection 'Client
+  SndFileConnection :: Connection -> SndFileTransfer -> ChatDirection 'Agent
+  RcvFileConnection :: Connection -> RcvFileTransfer -> ChatDirection 'Agent
 
 deriving instance Eq (ChatDirection p)
 
@@ -42,9 +47,13 @@ fromConnection :: ChatDirection 'Agent -> Connection
 fromConnection = \case
   ReceivedDirectMessage conn _ -> conn
   ReceivedGroupMessage conn _ _ -> conn
+  SndFileConnection conn _ -> conn
+  RcvFileConnection conn _ -> conn
 
 data ChatMsgEvent
   = XMsgNew MsgContent
+  | XFile FileInvitation
+  | XFileAcpt String
   | XInfo Profile
   | XGrpInv GroupInvitation
   | XGrpAcpt MemberId
@@ -100,6 +109,13 @@ toChatMessage RawChatMessage {chatMsgId, chatMsgEvent, chatMsgParams, chatMsgBod
       t <- toMsgType mt
       files <- mapM (toContentInfo <=< parseAll contentInfoP) rawFiles
       chatMsg . XMsgNew $ MsgContent {messageType = t, files, content = body}
+    ("x.file", [name, size, qInfo]) -> do
+      let fileName = T.unpack $ safeDecodeUtf8 name
+      fileSize <- parseAll A.decimal size
+      fileQInfo <- parseAll smpQueueInfoP qInfo
+      chatMsg . XFile $ FileInvitation {fileName, fileSize, fileQInfo}
+    ("x.file.acpt", [name]) ->
+      chatMsg . XFileAcpt . T.unpack $ safeDecodeUtf8 name
     ("x.info", []) -> do
       profile <- getJSON body
       chatMsg $ XInfo profile
@@ -174,6 +190,10 @@ rawChatMessage ChatMessage {chatMsgId, chatMsgEvent, chatDAG} =
     XMsgNew MsgContent {messageType = t, files, content} ->
       let rawFiles = map (serializeContentInfo . rawContentInfo) files
        in rawMsg "x.msg.new" (rawMsgType t : rawFiles) content
+    XFile FileInvitation {fileName, fileSize, fileQInfo} ->
+      rawMsg "x.file" [encodeUtf8 $ T.pack fileName, bshow fileSize, serializeSmpQueueInfo fileQInfo] []
+    XFileAcpt fileName ->
+      rawMsg "x.file.acpt" [encodeUtf8 $ T.pack fileName] []
     XInfo profile ->
       rawMsg "x.info" [] [jsonBody profile]
     XGrpInv (GroupInvitation (fromMemId, fromRole) (memId, role) qInfo groupProfile) ->

src/Simplex/Chat/Store.hs

@@ -7,6 +7,7 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TupleSections #-}
@@ -27,6 +28,9 @@ module Simplex.Chat.Store
     updateUserProfile,
     updateContactProfile,
     getUserContacts,
+    getLiveSndFileTransfers,
+    getLiveRcvFileTransfers,
+    getPendingSndChunks,
     getPendingConnections,
     getContactConnections,
     getConnectionChatDirection,
@@ -58,6 +62,19 @@ module Simplex.Chat.Store
     matchReceivedProbeHash,
     matchSentProbe,
     mergeContactRecords,
+    createSndFileTransfer,
+    updateSndFileStatus,
+    createSndFileChunk,
+    updateSndFileChunkMsg,
+    updateSndFileChunkSent,
+    createRcvFileTransfer,
+    getRcvFileTransfer,
+    acceptRcvFileTransfer,
+    updateRcvFileStatus,
+    createRcvFileChunk,
+    updatedRcvFileChunkStored,
+    getFileTransfer,
+    getFileTransferProgress,
   )
 where
 
@@ -85,11 +102,11 @@ import qualified Database.SQLite.Simple as DB
 import Database.SQLite.Simple.QQ (sql)
 import Simplex.Chat.Protocol
 import Simplex.Chat.Types
-import Simplex.Messaging.Agent.Protocol (AParty (..), ConnId, SMPQueueInfo)
+import Simplex.Messaging.Agent.Protocol (AParty (..), AgentMsgId, ConnId, SMPQueueInfo)
 import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore (..), createSQLiteStore, withTransaction)
 import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
 import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Util (bshow, liftIOEither)
+import Simplex.Messaging.Util (bshow, liftIOEither, (<$$>))
 import System.FilePath (takeBaseName, takeExtension)
 import UnliftIO.STM
 
@@ -315,7 +332,7 @@ getContact_ db userId localDisplayName = do
           db
           [sql|
             SELECT c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact,
-              c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.created_at
+              c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.created_at
             FROM connections c
             WHERE c.user_id = :user_id AND c.contact_id == :contact_id
             ORDER BY c.connection_id DESC
@@ -334,9 +351,58 @@ getContact_ db userId localDisplayName = do
 getUserContacts :: MonadUnliftIO m => SQLiteStore -> User -> m [Contact]
 getUserContacts st User {userId} =
   liftIO . withTransaction st $ \db -> do
-    contactNames <- liftIO $ map fromOnly <$> DB.query db "SELECT local_display_name FROM contacts WHERE user_id = ?" (Only userId)
+    contactNames <- map fromOnly <$> DB.query db "SELECT local_display_name FROM contacts WHERE user_id = ?" (Only userId)
     rights <$> mapM (runExceptT . getContact_ db userId) contactNames
 
+getLiveSndFileTransfers :: MonadUnliftIO m => SQLiteStore -> User -> m [SndFileTransfer]
+getLiveSndFileTransfers st User {userId} =
+  liftIO . withTransaction st $ \db -> do
+    fileIds :: [Int64] <-
+      map fromOnly
+        <$> DB.query
+          db
+          [sql|
+            SELECT DISTINCT f.file_id
+            FROM files f
+            JOIN snd_files s
+            WHERE f.user_id = ? AND s.file_status IN (?, ?, ?)
+          |]
+          (userId, FSNew, FSAccepted, FSConnected)
+    concatMap (filter liveTransfer) . rights <$> mapM (getSndFileTransfers_ db userId) fileIds
+  where
+    liveTransfer :: SndFileTransfer -> Bool
+    liveTransfer SndFileTransfer {fileStatus} = fileStatus `elem` [FSNew, FSAccepted, FSConnected]
+
+getLiveRcvFileTransfers :: MonadUnliftIO m => SQLiteStore -> User -> m [RcvFileTransfer]
+getLiveRcvFileTransfers st User {userId} =
+  liftIO . withTransaction st $ \db -> do
+    fileIds :: [Int64] <-
+      map fromOnly
+        <$> DB.query
+          db
+          [sql|
+            SELECT f.file_id
+            FROM files f
+            JOIN rcv_files r
+            WHERE f.user_id = ? AND r.file_status IN (?, ?)
+          |]
+          (userId, FSAccepted, FSConnected)
+    rights <$> mapM (getRcvFileTransfer_ db userId) fileIds
+
+getPendingSndChunks :: MonadUnliftIO m => SQLiteStore -> Int64 -> Int64 -> m [Integer]
+getPendingSndChunks st fileId connId =
+  liftIO . withTransaction st $ \db ->
+    map fromOnly
+      <$> DB.query
+        db
+        [sql|
+          SELECT chunk_number
+          FROM snd_file_chunks
+          WHERE file_id = ? AND connection_id = ? AND chunk_agent_msg_id IS NULL
+          ORDER BY chunk_number
+        |]
+        (fileId, connId)
+
 getPendingConnections :: MonadUnliftIO m => SQLiteStore -> User -> m [Connection]
 getPendingConnections st User {userId} =
   liftIO . withTransaction st $ \db ->
@@ -344,12 +410,12 @@ getPendingConnections st User {userId} =
       <$> DB.queryNamed
         db
         [sql|
-          SELECT c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact,
+          SELECT connection_id, agent_conn_id, conn_level, via_contact,
-            c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.created_at
+            conn_status, conn_type, contact_id, group_member_id, snd_file_id, rcv_file_id, created_at
-          FROM connections c
+          FROM connections
-          WHERE c.user_id = :user_id
+          WHERE user_id = :user_id
-            AND c.conn_type = :conn_type
+            AND conn_type = :conn_type
-            AND c.contact_id IS NULL
+            AND contact_id IS NULL
         |]
         [":user_id" := userId, ":conn_type" := ConnContact]
 
@@ -361,7 +427,7 @@ getContactConnections st userId displayName =
         db
         [sql|
           SELECT c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact,
-            c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.created_at
+            c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.created_at
           FROM connections c
           JOIN contacts cs ON c.contact_id == cs.contact_id
           WHERE c.user_id = :user_id
@@ -373,22 +439,24 @@ getContactConnections st userId displayName =
     connections [] = Left $ SEContactNotFound displayName
     connections rows = Right $ map toConnection rows
 
-type ConnectionRow = (Int64, ConnId, Int, Maybe Int64, ConnStatus, ConnType, Maybe Int64, Maybe Int64, UTCTime)
+type ConnectionRow = (Int64, ConnId, Int, Maybe Int64, ConnStatus, ConnType, Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64, UTCTime)
 
-type MaybeConnectionRow = (Maybe Int64, Maybe ConnId, Maybe Int, Maybe Int64, Maybe ConnStatus, Maybe ConnType, Maybe Int64, Maybe Int64, Maybe UTCTime)
+type MaybeConnectionRow = (Maybe Int64, Maybe ConnId, Maybe Int, Maybe Int64, Maybe ConnStatus, Maybe ConnType, Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64, Maybe UTCTime)
 
 toConnection :: ConnectionRow -> Connection
-toConnection (connId, agentConnId, connLevel, viaContact, connStatus, connType, contactId, groupMemberId, createdAt) =
+toConnection (connId, agentConnId, connLevel, viaContact, connStatus, connType, contactId, groupMemberId, sndFileId, rcvFileId, createdAt) =
   let entityId = entityId_ connType
    in Connection {connId, agentConnId, connLevel, viaContact, connStatus, connType, entityId, createdAt}
   where
     entityId_ :: ConnType -> Maybe Int64
     entityId_ ConnContact = contactId
     entityId_ ConnMember = groupMemberId
+    entityId_ ConnRcvFile = rcvFileId
+    entityId_ ConnSndFile = sndFileId
 
 toMaybeConnection :: MaybeConnectionRow -> Maybe Connection
-toMaybeConnection (Just connId, Just agentConnId, Just connLevel, viaContact, Just connStatus, Just connType, contactId, groupMemberId, Just createdAt) =
+toMaybeConnection (Just connId, Just agentConnId, Just connLevel, viaContact, Just connStatus, Just connType, contactId, groupMemberId, sndFileId, rcvFileId, Just createdAt) =
-  Just $ toConnection (connId, agentConnId, connLevel, viaContact, connStatus, connType, contactId, groupMemberId, createdAt)
+  Just $ toConnection (connId, agentConnId, connLevel, viaContact, connStatus, connType, contactId, groupMemberId, sndFileId, rcvFileId, createdAt)
 toMaybeConnection _ = Nothing
 
 getMatchingContacts :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> m [Contact]
@@ -515,15 +583,17 @@ getConnectionChatDirection :: StoreMonad m => SQLiteStore -> User -> ConnId -> m
 getConnectionChatDirection st User {userId, userContactId} agentConnId =
   liftIOEither . withTransaction st $ \db -> runExceptT $ do
     c@Connection {connType, entityId} <- getConnection_ db
-    case connType of
+    case entityId of
-      ConnMember ->
+      Nothing ->
-        case entityId of
+        if connType == ConnContact
-          Nothing -> throwError $ SEInternal "group member without connection"
+          then pure $ ReceivedDirectMessage c Nothing
-          Just groupMemberId -> uncurry (ReceivedGroupMessage c) <$> getGroupAndMember_ db groupMemberId c
+          else throwError $ SEInternal $ "connection " <> bshow connType <> " without entity"
-      ConnContact ->
+      Just entId ->
-        ReceivedDirectMessage c <$> case entityId of
+        case connType of
-          Nothing -> pure Nothing
+          ConnMember -> uncurry (ReceivedGroupMessage c) <$> getGroupAndMember_ db entId c
-          Just contactId -> Just <$> getContactRec_ db contactId c
+          ConnContact -> ReceivedDirectMessage c . Just <$> getContactRec_ db entId c
+          ConnSndFile -> SndFileConnection c <$> getConnSndFileTransfer_ db entId c
+          ConnRcvFile -> RcvFileConnection c <$> ExceptT (getRcvFileTransfer_ db userId entId)
   where
     getConnection_ :: DB.Connection -> ExceptT StoreError IO Connection
     getConnection_ db = ExceptT $ do
@@ -532,7 +602,7 @@ getConnectionChatDirection st User {userId, userContactId} agentConnId =
           db
           [sql|
             SELECT connection_id, agent_conn_id, conn_level, via_contact,
-              conn_status, conn_type, contact_id, group_member_id, created_at
+              conn_status, conn_type, contact_id, group_member_id, snd_file_id, rcv_file_id, created_at
             FROM connections
             WHERE user_id = ? AND agent_conn_id = ?
           |]
@@ -578,6 +648,22 @@ getConnectionChatDirection st User {userId, userContactId} agentConnId =
       let member = toGroupMember userContactId memberRow
        in Right (groupName, (member :: GroupMember) {activeConn = Just c})
     toGroupAndMember _ _ = Left $ SEInternal "referenced group member not found"
+    getConnSndFileTransfer_ :: DB.Connection -> Int64 -> Connection -> ExceptT StoreError IO SndFileTransfer
+    getConnSndFileTransfer_ db fileId Connection {connId} =
+      ExceptT $
+        sndFileTransfer_ fileId connId
+          <$> DB.query
+            db
+            [sql|
+              SELECT s.file_status, f.file_name, f.file_size, f.chunk_size, f.file_path
+              FROM snd_files s
+              JOIN files f USING (file_id)
+              WHERE f.user_id = ? AND f.file_id = ? AND s.connection_id = ?
+            |]
+            (userId, fileId, connId)
+    sndFileTransfer_ :: Int64 -> Int64 -> [(FileStatus, String, Integer, Integer, FilePath)] -> Either StoreError SndFileTransfer
+    sndFileTransfer_ fileId connId [(fileStatus, fileName, fileSize, chunkSize, filePath)] = Right SndFileTransfer {..}
+    sndFileTransfer_ fileId _ _ = Left $ SESndFileNotFound fileId
 
 updateConnectionStatus :: MonadUnliftIO m => SQLiteStore -> Connection -> ConnStatus -> m ()
 updateConnectionStatus st Connection {connId} connStatus =
@@ -655,7 +741,7 @@ getGroup_ db User {userId, userContactId} localDisplayName = do
               m.group_member_id, m.member_id, m.member_role, m.member_category, m.member_status,
               m.invited_by, m.local_display_name, m.contact_id, p.display_name, p.full_name,
               c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact,
-              c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.created_at
+              c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.created_at
             FROM group_members m
             JOIN contact_profiles p ON p.contact_profile_id = m.contact_profile_id
             LEFT JOIN connections c ON c.connection_id = (
@@ -1011,7 +1097,7 @@ getViaGroupMember st User {userId, userContactId} Contact {contactId} =
             m.group_member_id, m.member_id, m.member_role, m.member_category, m.member_status,
             m.invited_by, m.local_display_name, m.contact_id, p.display_name, p.full_name,
             c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact,
-            c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.created_at
+            c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.created_at
           FROM group_members m
           JOIN contacts ct ON ct.contact_id = m.contact_id
           JOIN contact_profiles p ON p.contact_profile_id = m.contact_profile_id
@@ -1041,7 +1127,7 @@ getViaGroupContact st User {userId} GroupMember {groupMemberId} =
           SELECT
             ct.contact_id, ct.local_display_name, p.display_name, p.full_name, ct.via_group,
             c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact,
-            c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.created_at
+            c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.created_at
           FROM contacts ct
           JOIN contact_profiles p ON ct.contact_profile_id = p.contact_profile_id
           JOIN connections c ON c.connection_id = (
@@ -1062,6 +1148,225 @@ getViaGroupContact st User {userId} GroupMember {groupMemberId} =
        in Just Contact {contactId, localDisplayName, profile, activeConn, viaGroup}
     toContact _ = Nothing
 
+createSndFileTransfer :: MonadUnliftIO m => SQLiteStore -> UserId -> Int64 -> FilePath -> FileInvitation -> ConnId -> Integer -> m SndFileTransfer
+createSndFileTransfer st userId contactId filePath FileInvitation {fileName, fileSize} agentConnId chunkSize =
+  liftIO . withTransaction st $ \db -> do
+    DB.execute db "INSERT INTO files (user_id, contact_id, file_name, file_path, file_size, chunk_size) VALUES (?, ?, ?, ?, ?, ?)" (userId, contactId, fileName, filePath, fileSize, chunkSize)
+    fileId <- insertedRowId db
+    Connection {connId} <- createSndFileConnection_ db userId fileId agentConnId
+    let fileStatus = FSNew
+    DB.execute db "INSERT INTO snd_files (file_id, file_status, connection_id) VALUES (?, ?, ?)" (fileId, fileStatus, connId)
+    pure SndFileTransfer {..}
+
+createSndFileConnection_ :: DB.Connection -> UserId -> Int64 -> ConnId -> IO Connection
+createSndFileConnection_ db userId fileId agentConnId = do
+  createdAt <- getCurrentTime
+  let connType = ConnSndFile
+      connStatus = ConnNew
+  DB.execute
+    db
+    [sql|
+      INSERT INTO connections
+        (user_id, snd_file_id, agent_conn_id, conn_status, conn_type, created_at) VALUES (?,?,?,?,?,?)
+    |]
+    (userId, fileId, agentConnId, connStatus, connType, createdAt)
+  connId <- insertedRowId db
+  pure Connection {connId, agentConnId, connType, entityId = Just fileId, viaContact = Nothing, connLevel = 0, connStatus, createdAt}
+
+updateSndFileStatus :: MonadUnliftIO m => SQLiteStore -> SndFileTransfer -> FileStatus -> m ()
+updateSndFileStatus st SndFileTransfer {fileId, connId} status =
+  liftIO . withTransaction st $ \db ->
+    DB.execute db "UPDATE snd_files SET file_status = ? WHERE file_id = ? AND connection_id = ?" (status, fileId, connId)
+
+createSndFileChunk :: MonadUnliftIO m => SQLiteStore -> SndFileTransfer -> m (Maybe Integer)
+createSndFileChunk st SndFileTransfer {fileId, connId, fileSize, chunkSize} =
+  liftIO . withTransaction st $ \db -> do
+    chunkNo <- getLastChunkNo db
+    insertChunk db chunkNo
+    pure chunkNo
+  where
+    getLastChunkNo db = do
+      ns <- DB.query db "SELECT chunk_number FROM snd_file_chunks WHERE file_id = ? AND connection_id = ? AND chunk_sent = 1 ORDER BY chunk_number DESC LIMIT 1" (fileId, connId)
+      pure $ case map fromOnly ns of
+        [] -> Just 1
+        n : _ -> if n * chunkSize >= fileSize then Nothing else Just (n + 1)
+    insertChunk db = \case
+      Just chunkNo -> DB.execute db "INSERT OR REPLACE INTO snd_file_chunks (file_id, connection_id, chunk_number) VALUES (?, ?, ?)" (fileId, connId, chunkNo)
+      Nothing -> pure ()
+
+updateSndFileChunkMsg :: MonadUnliftIO m => SQLiteStore -> SndFileTransfer -> Integer -> AgentMsgId -> m ()
+updateSndFileChunkMsg st SndFileTransfer {fileId, connId} chunkNo msgId =
+  liftIO . withTransaction st $ \db ->
+    DB.execute
+      db
+      [sql|
+        UPDATE snd_file_chunks
+        SET chunk_agent_msg_id = ?
+        WHERE file_id = ? AND connection_id = ? AND chunk_number = ?
+      |]
+      (msgId, fileId, connId, chunkNo)
+
+updateSndFileChunkSent :: MonadUnliftIO m => SQLiteStore -> SndFileTransfer -> AgentMsgId -> m ()
+updateSndFileChunkSent st SndFileTransfer {fileId, connId} msgId =
+  liftIO . withTransaction st $ \db ->
+    DB.execute
+      db
+      [sql|
+        UPDATE snd_file_chunks
+        SET chunk_sent = 1
+        WHERE file_id = ? AND connection_id = ? AND chunk_agent_msg_id = ?
+      |]
+      (fileId, connId, msgId)
+
+createRcvFileTransfer :: MonadUnliftIO m => SQLiteStore -> UserId -> Int64 -> FileInvitation -> Integer -> m RcvFileTransfer
+createRcvFileTransfer st userId contactId f@FileInvitation {fileName, fileSize, fileQInfo} chunkSize =
+  liftIO . withTransaction st $ \db -> do
+    DB.execute db "INSERT INTO files (user_id, contact_id, file_name, file_size, chunk_size) VALUES (?, ?, ?, ?, ?)" (userId, contactId, fileName, fileSize, chunkSize)
+    fileId <- insertedRowId db
+    DB.execute db "INSERT INTO rcv_files (file_id, file_status, file_queue_info) VALUES (?, ?, ?)" (fileId, FSNew, fileQInfo)
+    pure RcvFileTransfer {fileId, fileInvitation = f, fileStatus = RFSNew, chunkSize}
+
+getRcvFileTransfer :: StoreMonad m => SQLiteStore -> UserId -> Int64 -> m RcvFileTransfer
+getRcvFileTransfer st userId fileId =
+  liftIOEither . withTransaction st $ \db ->
+    getRcvFileTransfer_ db userId fileId
+
+getRcvFileTransfer_ :: DB.Connection -> UserId -> Int64 -> IO (Either StoreError RcvFileTransfer)
+getRcvFileTransfer_ db userId fileId =
+  rcvFileTransfer
+    <$> DB.query
+      db
+      [sql|
+          SELECT r.file_status, r.file_queue_info, f.file_name,
+            f.file_size, f.chunk_size, f.file_path, c.connection_id, c.agent_conn_id
+          FROM rcv_files r
+          JOIN files f USING (file_id)
+          LEFT JOIN connections c ON r.file_id = c.rcv_file_id
+          WHERE f.user_id = ? AND f.file_id = ?
+        |]
+      (userId, fileId)
+  where
+    rcvFileTransfer ::
+      [(FileStatus, SMPQueueInfo, String, Integer, Integer, Maybe FilePath, Maybe Int64, Maybe ConnId)] ->
+      Either StoreError RcvFileTransfer
+    rcvFileTransfer [(fileStatus', fileQInfo, fileName, fileSize, chunkSize, filePath_, connId_, agentConnId_)] =
+      let fileInv = FileInvitation {fileName, fileSize, fileQInfo}
+          fileInfo = (filePath_, connId_, agentConnId_)
+       in case fileStatus' of
+            FSNew -> Right RcvFileTransfer {fileId, fileInvitation = fileInv, fileStatus = RFSNew, chunkSize}
+            FSAccepted -> ft fileInv RFSAccepted fileInfo
+            FSConnected -> ft fileInv RFSConnected fileInfo
+            FSComplete -> ft fileInv RFSComplete fileInfo
+            FSCancelled -> ft fileInv RFSCancelled fileInfo
+      where
+        ft fileInvitation rfs = \case
+          (Just filePath, Just connId, Just agentConnId) ->
+            let fileStatus = rfs RcvFileInfo {filePath, connId, agentConnId}
+             in Right RcvFileTransfer {..}
+          _ -> Left $ SERcvFileInvalid fileId
+    rcvFileTransfer _ = Left $ SERcvFileNotFound fileId
+
+acceptRcvFileTransfer :: StoreMonad m => SQLiteStore -> UserId -> Int64 -> ConnId -> FilePath -> m ()
+acceptRcvFileTransfer st userId fileId agentConnId filePath =
+  liftIO . withTransaction st $ \db -> do
+    DB.execute db "UPDATE files SET file_path = ? WHERE user_id = ? AND file_id = ?" (filePath, userId, fileId)
+    DB.execute db "UPDATE rcv_files SET file_status = ? WHERE file_id = ?" (FSAccepted, fileId)
+
+    DB.execute db "INSERT INTO connections (agent_conn_id, conn_status, conn_type, rcv_file_id, user_id) VALUES (?, ?, ?, ?, ?)" (agentConnId, ConnJoined, ConnRcvFile, fileId, userId)
+
+updateRcvFileStatus :: MonadUnliftIO m => SQLiteStore -> RcvFileTransfer -> FileStatus -> m ()
+updateRcvFileStatus st RcvFileTransfer {fileId} status =
+  liftIO . withTransaction st $ \db ->
+    DB.execute db "UPDATE rcv_files SET file_status = ? WHERE file_id = ?" (status, fileId)
+
+createRcvFileChunk :: MonadUnliftIO m => SQLiteStore -> RcvFileTransfer -> Integer -> AgentMsgId -> m RcvChunkStatus
+createRcvFileChunk st RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileSize}, chunkSize} chunkNo msgId =
+  liftIO . withTransaction st $ \db -> do
+    status <- getLastChunkNo db
+    unless (status == RcvChunkError) $
+      DB.execute db "INSERT OR REPLACE INTO rcv_file_chunks (file_id, chunk_number, chunk_agent_msg_id) VALUES (?, ?, ?)" (fileId, chunkNo, msgId)
+    pure status
+  where
+    getLastChunkNo db = do
+      ns <- DB.query db "SELECT chunk_number FROM rcv_file_chunks WHERE file_id = ? ORDER BY chunk_number DESC LIMIT 1" (Only fileId)
+      pure $ case map fromOnly ns of
+        [] -> if chunkNo == 1 then RcvChunkOk else RcvChunkError
+        n : _
+          | chunkNo == n -> RcvChunkDuplicate
+          | chunkNo == n + 1 ->
+            let prevSize = n * chunkSize
+             in if prevSize >= fileSize
+                  then RcvChunkError
+                  else
+                    if prevSize + chunkSize >= fileSize
+                      then RcvChunkFinal
+                      else RcvChunkOk
+          | otherwise -> RcvChunkError
+
+updatedRcvFileChunkStored :: MonadUnliftIO m => SQLiteStore -> RcvFileTransfer -> Integer -> m ()
+updatedRcvFileChunkStored st RcvFileTransfer {fileId} chunkNo =
+  liftIO . withTransaction st $ \db ->
+    DB.execute
+      db
+      [sql|
+        UPDATE rcv_file_chunks
+        SET chunk_stored = 1
+        WHERE file_id = ? AND chunk_number = ?
+      |]
+      (fileId, chunkNo)
+
+getFileTransfer :: StoreMonad m => SQLiteStore -> UserId -> Int64 -> m FileTransfer
+getFileTransfer st userId fileId =
+  liftIOEither . withTransaction st $ \db ->
+    getFileTransfer_ db userId fileId
+
+getFileTransferProgress :: StoreMonad m => SQLiteStore -> UserId -> Int64 -> m (FileTransfer, [Integer])
+getFileTransferProgress st userId fileId =
+  liftIOEither . withTransaction st $ \db -> runExceptT $ do
+    ft <- ExceptT $ getFileTransfer_ db userId fileId
+    liftIO $
+      (ft,) . map fromOnly <$> case ft of
+        FTSnd _ -> DB.query db "SELECT COUNT(*) FROM snd_file_chunks WHERE file_id = ? and chunk_sent = 1 GROUP BY connection_id" (Only fileId)
+        FTRcv _ -> DB.query db "SELECT COUNT(*) FROM rcv_file_chunks WHERE file_id = ? AND chunk_stored = 1" (Only fileId)
+
+getFileTransfer_ :: DB.Connection -> UserId -> Int64 -> IO (Either StoreError FileTransfer)
+getFileTransfer_ db userId fileId =
+  fileTransfer
+    =<< DB.query
+      db
+      [sql|
+        SELECT s.file_id, r.file_id
+        FROM files f
+        LEFT JOIN snd_files s ON s.file_id = f.file_id
+        LEFT JOIN rcv_files r ON r.file_id = f.file_id
+        WHERE user_id = ? AND f.file_id = ?
+      |]
+      (userId, fileId)
+  where
+    fileTransfer :: [(Maybe Int64, Maybe Int64)] -> IO (Either StoreError FileTransfer)
+    fileTransfer ((Just _, Nothing) : _) = FTSnd <$$> getSndFileTransfers_ db userId fileId
+    fileTransfer [(Nothing, Just _)] = FTRcv <$$> getRcvFileTransfer_ db userId fileId
+    fileTransfer _ = pure . Left $ SEFileNotFound fileId
+
+getSndFileTransfers_ :: DB.Connection -> UserId -> Int64 -> IO (Either StoreError [SndFileTransfer])
+getSndFileTransfers_ db userId fileId =
+  sndFileTransfers
+    <$> DB.query
+      db
+      [sql|
+        SELECT s.file_status, f.file_name, f.file_size, f.chunk_size, f.file_path, s.connection_id, c.agent_conn_id
+        FROM snd_files s
+        JOIN files f USING (file_id)
+        JOIN connections c USING (connection_id)
+        WHERE f.user_id = ? AND f.file_id = ?
+      |]
+      (userId, fileId)
+  where
+    sndFileTransfers :: [(FileStatus, String, Integer, Integer, FilePath, Int64, ConnId)] -> Either StoreError [SndFileTransfer]
+    sndFileTransfers [] = Left $ SESndFileNotFound fileId
+    sndFileTransfers fts = Right $ map sndFileTransfer fts
+    sndFileTransfer (fileStatus, fileName, fileSize, chunkSize, filePath, connId, agentConnId) = SndFileTransfer {..}
+
 -- | Saves unique local display name based on passed displayName, suffixed with _N if required.
 -- This function should be called inside transaction.
 withLocalDisplayName :: forall a. DB.Connection -> UserId -> Text -> (Text -> IO a) -> IO (Either StoreError a)
@@ -1126,6 +1431,10 @@ data StoreError
   | SEDuplicateGroupMember
   | SEGroupAlreadyJoined
   | SEGroupInvitationNotFound
+  | SESndFileNotFound Int64
+  | SERcvFileNotFound Int64
+  | SEFileNotFound Int64
+  | SERcvFileInvalid Int64
   | SEConnectionNotFound ConnId
   | SEIntroNotFound
   | SEUniqueID

src/Simplex/Chat/Styled.hs

@@ -7,6 +7,7 @@ module Simplex.Chat.Styled
     styleMarkdown,
     styleMarkdownText,
     sLength,
+    sShow,
   )
 where
 
@@ -54,6 +55,9 @@ instance StyledFormat Text where
   styled f = styled f . T.unpack
   plain = Styled [] . T.unpack
 
+sShow :: Show a => a -> StyledString
+sShow = plain . show
+
 sgr :: Format -> [SGR]
 sgr = \case
   Bold -> [SetConsoleIntensity BoldIntensity]

src/Simplex/Chat/Types.hs

@@ -299,6 +299,76 @@ serializeMemberStatus = \case
   GSMemComplete -> "complete"
   GSMemCreator -> "creator"
 
+data SndFileTransfer = SndFileTransfer
+  { fileId :: Int64,
+    fileName :: String,
+    filePath :: String,
+    fileSize :: Integer,
+    chunkSize :: Integer,
+    connId :: Int64,
+    agentConnId :: ConnId,
+    fileStatus :: FileStatus
+  }
+  deriving (Eq, Show)
+
+data FileInvitation = FileInvitation
+  { fileName :: String,
+    fileSize :: Integer,
+    fileQInfo :: SMPQueueInfo
+  }
+  deriving (Eq, Show)
+
+data RcvFileTransfer = RcvFileTransfer
+  { fileId :: Int64,
+    fileInvitation :: FileInvitation,
+    fileStatus :: RcvFileStatus,
+    chunkSize :: Integer
+  }
+  deriving (Eq, Show)
+
+data RcvFileStatus
+  = RFSNew
+  | RFSAccepted RcvFileInfo
+  | RFSConnected RcvFileInfo
+  | RFSComplete RcvFileInfo
+  | RFSCancelled RcvFileInfo
+  deriving (Eq, Show)
+
+data RcvFileInfo = RcvFileInfo
+  { filePath :: FilePath,
+    connId :: Int64,
+    agentConnId :: ConnId
+  }
+  deriving (Eq, Show)
+
+data FileTransfer = FTSnd [SndFileTransfer] | FTRcv RcvFileTransfer
+
+data FileStatus = FSNew | FSAccepted | FSConnected | FSComplete | FSCancelled deriving (Eq, Show)
+
+instance FromField FileStatus where fromField = fromTextField_ fileStatusT
+
+instance ToField FileStatus where toField = toField . serializeFileStatus
+
+fileStatusT :: Text -> Maybe FileStatus
+fileStatusT = \case
+  "new" -> Just FSNew
+  "accepted" -> Just FSAccepted
+  "connected" -> Just FSConnected
+  "complete" -> Just FSComplete
+  "cancelled" -> Just FSCancelled
+  _ -> Nothing
+
+serializeFileStatus :: FileStatus -> Text
+serializeFileStatus = \case
+  FSNew -> "new"
+  FSAccepted -> "accepted"
+  FSConnected -> "connected"
+  FSComplete -> "complete"
+  FSCancelled -> "cancelled"
+
+data RcvChunkStatus = RcvChunkOk | RcvChunkFinal | RcvChunkDuplicate | RcvChunkError
+  deriving (Eq, Show)
+
 data Connection = Connection
   { connId :: Int64,
     agentConnId :: ConnId,
@@ -306,7 +376,7 @@ data Connection = Connection
     viaContact :: Maybe Int64,
     connType :: ConnType,
     connStatus :: ConnStatus,
-    entityId :: Maybe Int64, -- contact or group member ID
+    entityId :: Maybe Int64, -- contact, group member or file ID
     createdAt :: UTCTime
   }
   deriving (Eq, Show)
@@ -353,7 +423,7 @@ serializeConnStatus = \case
   ConnReady -> "ready"
   ConnDeleted -> "deleted"
 
-data ConnType = ConnContact | ConnMember
+data ConnType = ConnContact | ConnMember | ConnSndFile | ConnRcvFile
   deriving (Eq, Show)
 
 instance FromField ConnType where fromField = fromTextField_ connTypeT
@@ -364,12 +434,16 @@ connTypeT :: Text -> Maybe ConnType
 connTypeT = \case
   "contact" -> Just ConnContact
   "member" -> Just ConnMember
+  "snd_file" -> Just ConnSndFile
+  "rcv_file" -> Just ConnRcvFile
   _ -> Nothing
 
 serializeConnType :: ConnType -> Text
 serializeConnType = \case
   ConnContact -> "contact"
   ConnMember -> "member"
+  ConnSndFile -> "snd_file"
+  ConnRcvFile -> "rcv_file"
 
 data NewConnection = NewConnection
   { agentConnId :: ByteString,

src/Simplex/Chat/Util.hs

@@ -8,3 +8,9 @@ safeDecodeUtf8 :: ByteString -> Text
 safeDecodeUtf8 = decodeUtf8With onError
   where
     onError _ _ = Just '?'
+
+ifM :: Monad m => m Bool -> m a -> m a -> m a
+ifM ba t f = ba >>= \b -> if b then t else f
+
+unlessM :: Monad m => m Bool -> m () -> m ()
+unlessM b = ifM b $ pure ()

src/Simplex/Chat/View.hs

@@ -24,6 +24,20 @@ module Simplex.Chat.View
     showReceivedGroupMessage,
     showSentMessage,
     showSentGroupMessage,
+    showSentFileInvitation,
+    showSndFileStart,
+    showSndFileComplete,
+    showSndFileCancelled,
+    showSndFileRcvCancelled,
+    showReceivedFileInvitation,
+    showRcvFileAccepted,
+    showRcvFileStart,
+    showRcvFileComplete,
+    showRcvFileCancelled,
+    showRcvFileSndCancelled,
+    showFileTransferStatus,
+    showSndFileSubError,
+    showRcvFileSubError,
     showGroupCreated,
     showGroupDeletedUser,
     showGroupDeleted,
@@ -42,6 +56,7 @@ module Simplex.Chat.View
     showUserProfile,
     showUserProfileUpdated,
     showContactUpdated,
+    showMessageError,
     safeDecodeUtf8,
   )
 where
@@ -50,11 +65,13 @@ import Control.Monad.IO.Unlift
 import Control.Monad.Reader
 import Data.ByteString.Char8 (ByteString)
 import Data.Composition ((.:), (.:.))
+import Data.Int (Int64)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Time.Clock (DiffTime, UTCTime)
 import Data.Time.Format (defaultTimeLocale, formatTime)
 import Data.Time.LocalTime (TimeZone, ZonedTime, getCurrentTimeZone, getZonedTime, localDay, localTimeOfDay, timeOfDayToTime, utcToLocalTime, zonedTimeToLocalTime)
+import Numeric (showFFloat)
 import Simplex.Chat.Controller
 import Simplex.Chat.Markdown
 import Simplex.Chat.Store (StoreError (..))
@@ -124,6 +141,48 @@ showSentGroupMessage = showSentMessage_ . ttyToGroup
 showSentMessage_ :: ChatReader m => StyledString -> ByteString -> m ()
 showSentMessage_ to msg = printToView =<< liftIO (sentMessage to msg)
 
+showSentFileInvitation :: ChatReader m => ContactName -> SndFileTransfer -> m ()
+showSentFileInvitation = printToView .: sentFileInvitation
+
+showSndFileStart :: ChatReader m => Int64 -> m ()
+showSndFileStart = printToView . sndFileStart
+
+showSndFileComplete :: ChatReader m => Int64 -> m ()
+showSndFileComplete = printToView . sndFileComplete
+
+showSndFileCancelled :: ChatReader m => Int64 -> m ()
+showSndFileCancelled = printToView . sndFileCancelled
+
+showSndFileRcvCancelled :: ChatReader m => Int64 -> m ()
+showSndFileRcvCancelled = printToView . sndFileRcvCancelled
+
+showReceivedFileInvitation :: ChatReader m => ContactName -> RcvFileTransfer -> m ()
+showReceivedFileInvitation = printToView .: receivedFileInvitation
+
+showRcvFileAccepted :: ChatReader m => Int64 -> FilePath -> m ()
+showRcvFileAccepted = printToView .: rcvFileAccepted
+
+showRcvFileStart :: ChatReader m => Int64 -> m ()
+showRcvFileStart = printToView . rcvFileStart
+
+showRcvFileComplete :: ChatReader m => Int64 -> m ()
+showRcvFileComplete = printToView . rcvFileComplete
+
+showRcvFileCancelled :: ChatReader m => Int64 -> m ()
+showRcvFileCancelled = printToView . rcvFileCancelled
+
+showRcvFileSndCancelled :: ChatReader m => Int64 -> m ()
+showRcvFileSndCancelled = printToView . rcvFileSndCancelled
+
+showFileTransferStatus :: ChatReader m => (FileTransfer, [Integer]) -> m ()
+showFileTransferStatus = printToView . fileTransferStatus
+
+showSndFileSubError :: ChatReader m => SndFileTransfer -> ChatError -> m ()
+showSndFileSubError = printToView .: sndFileSubError
+
+showRcvFileSubError :: ChatReader m => RcvFileTransfer -> ChatError -> m ()
+showRcvFileSubError = printToView .: rcvFileSubError
+
 showGroupCreated :: ChatReader m => Group -> m ()
 showGroupCreated = printToView . groupCreated
 
@@ -178,6 +237,9 @@ showUserProfileUpdated = printToView .: userProfileUpdated
 showContactUpdated :: ChatReader m => Contact -> Contact -> m ()
 showContactUpdated = printToView .: contactUpdated
 
+showMessageError :: ChatReader m => Text -> Text -> m ()
+showMessageError = printToView .: messageError
+
 invitation :: SMPQueueInfo -> [StyledString]
 invitation qInfo =
   [ "pass this invitation to your contact (via another channel): ",
@@ -202,19 +264,19 @@ contactConnected :: Contact -> [StyledString]
 contactConnected ct = [ttyFullContact ct <> ": contact is connected"]
 
 contactDisconnected :: ContactName -> [StyledString]
-contactDisconnected c = [ttyContact c <> ": contact is disconnected (messages will be queued)"]
+contactDisconnected c = [ttyContact c <> ": disconnected from server (messages will be queued)"]
 
 contactAnotherClient :: ContactName -> [StyledString]
 contactAnotherClient c = [ttyContact c <> ": contact is connected to another client"]
 
 contactSubscribed :: ContactName -> [StyledString]
-contactSubscribed c = [ttyContact c <> ": contact is active"]
+contactSubscribed c = [ttyContact c <> ": connected to server"]
 
 contactSubError :: ContactName -> ChatError -> [StyledString]
-contactSubError c e = [ttyContact c <> ": contact error " <> plain (show e)]
+contactSubError c e = [ttyContact c <> ": contact error " <> sShow e]
 
 groupSubscribed :: GroupName -> [StyledString]
-groupSubscribed g = [ttyGroup g <> ": group is active"]
+groupSubscribed g = [ttyGroup g <> ": connected to server(s)"]
 
 groupEmpty :: GroupName -> [StyledString]
 groupEmpty g = [ttyGroup g <> ": group is empty"]
@@ -223,7 +285,7 @@ groupRemoved :: GroupName -> [StyledString]
 groupRemoved g = [ttyGroup g <> ": you are no longer a member or group deleted"]
 
 memberSubError :: GroupName -> ContactName -> ChatError -> [StyledString]
-memberSubError g c e = [ttyGroup g <> " member " <> ttyContact c <> " error: " <> plain (show e)]
+memberSubError g c e = [ttyGroup g <> " member " <> ttyContact c <> " error: " <> sShow e]
 
 groupCreated :: Group -> [StyledString]
 groupCreated g@Group {localDisplayName} =
@@ -317,7 +379,7 @@ contactsMerged _to@Contact {localDisplayName = c1} _from@Contact {localDisplayNa
 userProfile :: Profile -> [StyledString]
 userProfile Profile {displayName, fullName} =
   [ "user profile: " <> ttyFullName displayName fullName,
-    "use " <> highlight' "/p <display name>[ <full name>]" <> " to change it",
+    "use " <> highlight' "/p <display name> [<full name>]" <> " to change it",
     "(the updated profile will be sent to all your contacts)"
   ]
 
@@ -344,6 +406,9 @@ contactUpdated
     where
       fullNameUpdate = if T.null fullName' || fullName' == n' then " removed full name" else " updated full name: " <> plain fullName'
 
+messageError :: Text -> Text -> [StyledString]
+messageError prefix err = [plain prefix <> ": " <> plain err]
+
 receivedMessage :: StyledString -> UTCTime -> Text -> MsgIntegrity -> IO [StyledString]
 receivedMessage from utcTime msg mOk = do
   t <- formatUTCTime <$> getCurrentTimeZone <*> getZonedTime
@@ -382,6 +447,90 @@ prependFirst s (s' : ss) = (s <> s') : ss
 msgPlain :: Text -> [StyledString]
 msgPlain = map styleMarkdownText . T.lines
 
+sentFileInvitation :: ContactName -> SndFileTransfer -> [StyledString]
+sentFileInvitation cName SndFileTransfer {fileId, fileName} =
+  [ "offered to send the file " <> plain fileName <> " to " <> ttyContact cName,
+    "use " <> highlight ("/fc " <> show fileId) <> " to cancel sending"
+  ]
+
+sndFileStart :: Int64 -> [StyledString]
+sndFileStart fileId = ["started sending the file " <> sShow fileId]
+
+sndFileComplete :: Int64 -> [StyledString]
+sndFileComplete fileId = ["completed sending the file " <> sShow fileId]
+
+sndFileCancelled :: Int64 -> [StyledString]
+sndFileCancelled fileId = ["cancelled sending the file " <> sShow fileId]
+
+sndFileRcvCancelled :: Int64 -> [StyledString]
+sndFileRcvCancelled fileId = ["recipient cancelled receiving the file " <> sShow fileId]
+
+receivedFileInvitation :: ContactName -> RcvFileTransfer -> [StyledString]
+receivedFileInvitation c RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName, fileSize}} =
+  [ ttyContact c <> " wants to send you the file " <> plain fileName <> " (" <> humanReadableSize fileSize <> " / " <> sShow fileSize <> " bytes)",
+    "use " <> highlight ("/fr " <> show fileId <> " [<dir>/ | <path>]") <> " to receive it"
+  ]
+
+humanReadableSize :: Integer -> StyledString
+humanReadableSize size
+  | size < kB = sShow size <> " bytes"
+  | size < mB = hrSize kB "KiB"
+  | size < gB = hrSize mB "MiB"
+  | otherwise = hrSize gB "GiB"
+  where
+    hrSize sB name = plain $ unwords [showFFloat (Just 1) (fromIntegral size / (fromIntegral sB :: Double)) "", name]
+    kB = 1024
+    mB = kB * 1024
+    gB = mB * 1024
+
+rcvFileAccepted :: Int64 -> FilePath -> [StyledString]
+rcvFileAccepted fileId filePath = ["saving file " <> sShow fileId <> " to " <> plain filePath]
+
+rcvFileStart :: Int64 -> [StyledString]
+rcvFileStart fileId = ["started receiving the file " <> sShow fileId]
+
+rcvFileComplete :: Int64 -> [StyledString]
+rcvFileComplete fileId = ["completed receiving the file " <> sShow fileId]
+
+rcvFileCancelled :: Int64 -> [StyledString]
+rcvFileCancelled fileId = ["cancelled receiving the file " <> sShow fileId]
+
+rcvFileSndCancelled :: Int64 -> [StyledString]
+rcvFileSndCancelled fileId = ["sender cancelled sending the file " <> sShow fileId]
+
+fileTransferStatus :: (FileTransfer, [Integer]) -> [StyledString]
+fileTransferStatus (FTSnd [SndFileTransfer {fileStatus, fileSize, chunkSize}], chunksNum) =
+  ["sent file transfer " <> sndStatus]
+  where
+    sndStatus = case fileStatus of
+      FSNew -> "is not accepted yet"
+      FSAccepted -> "just started"
+      FSConnected -> "progress: " <> fileProgress chunksNum chunkSize fileSize
+      FSComplete -> "is complete"
+      FSCancelled -> "is cancelled"
+fileTransferStatus (FTSnd _fts, _chunks) = [] -- TODO group transfer
+fileTransferStatus (FTRcv RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileSize}, fileStatus, chunkSize}, chunksNum) =
+  ["received file transfer " <> rcvStatus]
+  where
+    rcvStatus = case fileStatus of
+      RFSNew -> "is not accepted yet, use " <> highlight ("/fr " <> show fileId) <> " to receive file"
+      RFSAccepted _ -> "just started"
+      RFSConnected _ -> "progress: " <> fileProgress chunksNum chunkSize fileSize
+      RFSComplete RcvFileInfo {filePath} -> "is complete, path: " <> plain filePath
+      RFSCancelled RcvFileInfo {filePath} -> "is cancelled, received part path: " <> plain filePath
+
+fileProgress :: [Integer] -> Integer -> Integer -> StyledString
+fileProgress chunksNum chunkSize fileSize =
+  sShow (sum chunksNum * chunkSize * 100 `div` fileSize) <> "% of " <> humanReadableSize fileSize
+
+sndFileSubError :: SndFileTransfer -> ChatError -> [StyledString]
+sndFileSubError SndFileTransfer {fileId, fileName} e =
+  ["sent file " <> sShow fileId <> " (" <> plain fileName <> ") error: " <> sShow e]
+
+rcvFileSubError :: RcvFileTransfer -> ChatError -> [StyledString]
+rcvFileSubError RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName}} e =
+  ["received file " <> sShow fileId <> " (" <> plain fileName <> ") error: " <> sShow e]
+
 chatError :: ChatError -> [StyledString]
 chatError = \case
   ChatError err -> case err of
@@ -394,16 +543,29 @@ chatError = \case
     CEGroupMemberUserRemoved -> ["you are no longer the member of the group"]
     CEGroupMemberNotFound c -> ["contact " <> ttyContact c <> " is not a group member"]
     CEGroupInternal s -> ["chat group bug: " <> plain s]
-  -- e -> ["chat error: " <> plain (show e)]
+    CEFileNotFound f -> ["file not found: " <> plain f]
+    CEFileAlreadyReceiving f -> ["file is already accepted: " <> plain f]
+    CEFileAlreadyExists f -> ["file already exists: " <> plain f]
+    CEFileRead f e -> ["cannot read file " <> plain f, sShow e]
+    CEFileWrite f e -> ["cannot write file " <> plain f, sShow e]
+    CEFileSend fileId e -> ["error sending file " <> sShow fileId <> ": " <> sShow e]
+    CEFileRcvChunk e -> ["error receiving file: " <> plain e]
+    CEFileInternal e -> ["file error: " <> plain e]
+  -- e -> ["chat error: " <> sShow e]
   ChatErrorStore err -> case err of
     SEDuplicateName -> ["this display name is already used by user, contact or group"]
     SEContactNotFound c -> ["no contact " <> ttyContact c]
     SEContactNotReady c -> ["contact " <> ttyContact c <> " is not active yet"]
     SEGroupNotFound g -> ["no group " <> ttyGroup g]
     SEGroupAlreadyJoined -> ["you already joined this group"]
-    e -> ["chat db error: " <> plain (show e)]
+    SEFileNotFound fileId -> fileNotFound fileId
-  ChatErrorAgent e -> ["smp agent error: " <> plain (show e)]
+    SESndFileNotFound fileId -> fileNotFound fileId
-  ChatErrorMessage e -> ["chat message error: " <> plain (show e)]
+    SERcvFileNotFound fileId -> fileNotFound fileId
+    e -> ["chat db error: " <> sShow e]
+  ChatErrorAgent e -> ["smp agent error: " <> sShow e]
+  ChatErrorMessage e -> ["chat message error: " <> sShow e]
+  where
+    fileNotFound fileId = ["file " <> sShow fileId <> " not found"]
 
 printToView :: (MonadUnliftIO m, MonadReader ChatController m) => [StyledString] -> m ()
 printToView s = asks chatTerminal >>= liftIO . (`printToTerminal` s)

src/Simplex/Chat/protocol.md

@@ -65,6 +65,7 @@ refMsgHash = 16*16(OCTET) ; SHA256 of agent message body
 ' x.grp.mem.inv 23456,234 x.text:NNN <invitation> '
 ' x.grp.mem.req 23456,123 x.json:NNN {...} '
 ' x.grp.mem.direct.inv 23456,234 x.text:NNN <invitation>  '
+' x.file name,size x.text:NNN <invitation> '
 ```
 
 ### Group protocol

stack.yaml

@@ -43,8 +43,7 @@ extra-deps:
   # - simplexmq-0.3.1@sha256:f247aaff3c16c5d3974a4ab4d5882ab50ac78073110997c0bceb05a74d10a325,6688
   # - ../simplexmq
   - github: simplex-chat/simplexmq
-    commit: dd5137c336d5525c38b068d7212964b4ab196a33
+    commit: 2ac903a2dd37c11a8612b19cd132cf43fe771fe4
-  # this commit is in PR #164
 #
 # extra-deps: []
 

tests/ChatClient.hs

@@ -15,7 +15,7 @@ import Control.Monad.Except
 import Data.List (dropWhileEnd)
 import Network.Socket
 import Simplex.Chat
-import Simplex.Chat.Controller (ChatController (..))
+import Simplex.Chat.Controller (ChatConfig (..), ChatController (..))
 import Simplex.Chat.Options
 import Simplex.Chat.Store
 import Simplex.Chat.Types (Profile)
@@ -145,9 +145,11 @@ serverCfg =
   ServerConfig
     { transports = [(serverPort, transport @TCP)],
       tbqSize = 1,
+      msgQueueQuota = 4,
       queueIdBytes = 12,
       msgIdBytes = 6,
       storeLog = Nothing,
+      blockSize = 4096,
       serverPrivateKey =
         -- full RSA private key (only for tests)
         "MIIFIwIBAAKCAQEArZyrri/NAwt5buvYjwu+B/MQeJUszDBpRgVqNddlI9kNwDXu\

tests/ChatTests.hs

@@ -7,10 +7,13 @@ module ChatTests where
 import ChatClient
 import Control.Concurrent.Async (concurrently_)
 import Control.Concurrent.STM
+import qualified Data.ByteString as B
 import Data.Char (isDigit)
 import qualified Data.Text as T
 import Simplex.Chat.Controller
 import Simplex.Chat.Types (Profile (..), User (..))
+import Simplex.Chat.Util (unlessM)
+import System.Directory (doesFileExist)
 import System.Timeout (timeout)
 import Test.Hspec
 
@@ -37,6 +40,10 @@ chatTests = do
     it "remove contact from group and add again" testGroupRemoveAdd
   describe "user profiles" $
     it "update user profiles and notify contacts" testUpdateProfile
+  describe "sending and receiving files" $ do
+    it "send and receive file" testFileTransfer
+    it "sender cancelled file transfer" testFileSndCancel
+    it "recipient cancelled file transfer" testFileRcvCancel
 
 testAddContact :: IO ()
 testAddContact =
@@ -359,7 +366,7 @@ testUpdateProfile =
       createGroup3 "team" alice bob cath
       alice ##> "/p"
       alice <## "user profile: alice (Alice)"
-      alice <## "use /p <display name>[ <full name>] to change it"
+      alice <## "use /p <display name> [<full name>] to change it"
       alice <## "(the updated profile will be sent to all your contacts)"
       alice ##> "/p alice"
       concurrentlyN_
@@ -394,6 +401,87 @@ testUpdateProfile =
             bob <## "use @cat <message> to send messages"
         ]
 
+testFileTransfer :: IO ()
+testFileTransfer =
+  testChat2 aliceProfile bobProfile $
+    \alice bob -> do
+      connectUsers alice bob
+      startFileTransfer alice bob
+      concurrentlyN_
+        [ do
+            bob #> "@alice receiving here..."
+            bob <## "completed receiving the file 1",
+          do
+            alice <# "bob> receiving here..."
+            alice <## "completed sending the file 1"
+        ]
+      src <- B.readFile "./tests/fixtures/test.jpg"
+      dest <- B.readFile "./tests/tmp/test.jpg"
+      dest `shouldBe` src
+
+testFileSndCancel :: IO ()
+testFileSndCancel =
+  testChat2 aliceProfile bobProfile $
+    \alice bob -> do
+      connectUsers alice bob
+      startFileTransfer alice bob
+      alice ##> "/fc 1"
+      concurrentlyN_
+        [ do
+            alice <## "cancelled sending the file 1"
+            alice ##> "/fs 1"
+            alice <## "sent file transfer is cancelled",
+          do
+            bob <## "sender cancelled sending the file 1"
+            bob ##> "/fs 1"
+            bob <## "received file transfer is cancelled, received part path: ./tests/tmp/test.jpg"
+        ]
+      checkPartialTransfer
+
+testFileRcvCancel :: IO ()
+testFileRcvCancel =
+  testChat2 aliceProfile bobProfile $
+    \alice bob -> do
+      connectUsers alice bob
+      startFileTransfer alice bob
+      bob ##> "/fs 1"
+      getTermLine bob >>= (`shouldStartWith` "received file transfer progress:")
+      waitFileExists "./tests/tmp/test.jpg"
+      bob ##> "/fc 1"
+      concurrentlyN_
+        [ do
+            bob <## "cancelled receiving the file 1"
+            bob ##> "/fs 1"
+            bob <## "received file transfer is cancelled, received part path: ./tests/tmp/test.jpg",
+          do
+            alice <## "recipient cancelled receiving the file 1"
+            alice ##> "/fs 1"
+            alice <## "sent file transfer is cancelled"
+        ]
+      checkPartialTransfer
+  where
+    waitFileExists f = unlessM (doesFileExist f) $ waitFileExists f
+
+startFileTransfer :: TestCC -> TestCC -> IO ()
+startFileTransfer alice bob = do
+  alice ##> "/f bob ./tests/fixtures/test.jpg"
+  alice <## "offered to send the file test.jpg to bob"
+  alice <## "use /fc 1 to cancel sending"
+  bob <## "alice wants to send you the file test.jpg (136.5 KiB / 139737 bytes)"
+  bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
+  bob ##> "/fr 1 ./tests/tmp"
+  bob <## "saving file 1 to ./tests/tmp/test.jpg"
+  concurrently_
+    (bob <## "started receiving the file 1")
+    (alice <## "started sending the file 1")
+
+checkPartialTransfer :: IO ()
+checkPartialTransfer = do
+  src <- B.readFile "./tests/fixtures/test.jpg"
+  dest <- B.readFile "./tests/tmp/test.jpg"
+  B.unpack src `shouldStartWith` B.unpack dest
+  B.length src > B.length dest `shouldBe` True
+
 connectUsers :: TestCC -> TestCC -> IO ()
 connectUsers cc1 cc2 = do
   name1 <- showName cc1