schema for sending files

simplex-chat · Aug 23, 2021 · 990fe74 · 990fe74
1 parent 9cfca4e
commit 990fe74
Show file tree

Hide file tree

Showing 6 changed files with 93 additions and 13 deletions.
diff --git a/migrations/20210612_initial.sql b/migrations/20210612_initial.sql
@@ -130,6 +130,51 @@ 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,
+  local_file_name TEXT NOT NULL,
+  lfn_base TEXT NOT NULL,
+  lfn_suffix INTEGER NOT NULL DEFAULT 0,
+  file_size INTEGER NOT NULL,
+  file_path TEXT,
+  created_at TEXT NOT NULL DEFAULT (datetime('now')),
+  user_id INTEGER NOT NULL REFERENCES users,
+  UNIQUE (user_id, local_file_name)
+);
+
+CREATE TABLE snd_files (
+  snd_file_id INTEGER PRIMARY KEY,
+  file_id INTEGER NOT NULL REFERENCES files ON DELETE RESTRICT,
+  file_status TEXT NOT NULL, -- created, accepted, completed
+  group_member_id INTEGER REFERENCES group_members ON DELETE RESTRICT,
+  connection_id INTEGER NOT NULL REFERENCES connections ON DELETE RESTRICT
+);
+
+CREATE TABLE rcv_files (
+  rcv_file_id INTEGER PRIMARY KEY,
+  file_id INTEGER NOT NULL REFERENCES files ON DELETE RESTRICT,
+  file_status TEXT NOT NULL, -- created, accepted, completed
+  file_queue_info BLOB
+);
+
+CREATE TABLE snd_file_chunks (
+  snd_file_id INTEGER NOT NULL REFERENCES snd_files,
+  chunk_number INTEGER NOT NULL,
+  chunk_agent_msg_id INTEGER NOT NULL,
+  chunk_sent INTEGER NOT NULL DEFAULT 0, -- 0 (sent to agent), 1 (sent to server)
+  PRIMARY KEY (snd_file_id, chunk_number)
+);
+
+CREATE TABLE rcv_file_chunks (
+  rcv_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 (rcv_file_id, chunk_number)
+);
+
 CREATE TABLE connections ( -- all SMP agent connections
   connection_id INTEGER PRIMARY KEY,
   agent_conn_id BLOB NOT NULL UNIQUE,
@@ -139,6 +184,7 @@ CREATE TABLE connections ( -- all SMP agent connections
   conn_type TEXT NOT NULL, -- contact, member, member_direct
   contact_id INTEGER REFERENCES contacts ON DELETE RESTRICT,
   group_member_id INTEGER REFERENCES group_members ON DELETE RESTRICT,
+  rcv_file_id INTEGER REFERENCES rcv_files ON DELETE RESTRICT,
   created_at TEXT NOT NULL DEFAULT (datetime('now')),
   user_id INTEGER NOT NULL REFERENCES users
 );

diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
@@ -70,6 +70,9 @@ data ChatCommand
   | DeleteGroup GroupName
   | ListMembers GroupName
   | SendGroupMessage GroupName ByteString
+  | SendFile ContactName FilePath
+  | SendGroupFile GroupName FilePath
+  | ReceiveFile Text
   | UpdateProfile Profile
   | ShowProfile
   | QuitChat
@@ -247,6 +250,9 @@ 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 _file -> pure ()
+  SendGroupFile _gName _file -> pure ()
+  ReceiveFile _fName -> pure ()
   UpdateProfile p -> unless (p == profile) $ do
     user' <- withStore $ \st -> updateUserProfile st user p
     asks currentUser >>= atomically . (`writeTVar` user')
@@ -308,6 +314,8 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = unles
       processDirectMessage agentMessage conn maybeContact
     ReceivedGroupMessage conn gName m ->
       processGroupMessage agentMessage conn gName m
+    ReceivedFileChunk conn f ->
+      processFileChunk agentMessage conn f
   where
     sent :: ACommand 'Agent -> Bool
     sent SENT {} = True
@@ -471,6 +479,14 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = unles
           _ -> messageError $ "unsupported message: " <> T.pack (show chatMsgEvent)
       _ -> pure ()
 
+    processFileChunk :: ACommand 'Agent -> Connection -> FileTransfer -> m ()
+    processFileChunk agentMsg conn f = case agentMsg of
+      REQ confId connInfo -> pure ()
+      INFO connInfo -> pure ()
+      CON -> pure ()
+      MSG meta msgBody -> pure ()
+      _ -> pure ()
+
     notifyMemberConnected :: GroupName -> GroupMember -> m ()
     notifyMemberConnected gName m@GroupMember {localDisplayName} = do
       showConnectedToGroupMember gName m
@@ -785,6 +801,9 @@ 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 @" <|> "/f @" <|> "/file " <|> "/f ") *> (SendFile <$> displayName <* A.space <*> filePath)
+    <|> ("/receive " <|> "/rf ") *> (ReceiveFile <$> fileName)
     <|> ("/markdown" <|> "/m") $> MarkdownHelp
     <|> ("/profile " <|> "/p ") *> (UpdateProfile <$> userProfile)
     <|> ("/profile" <|> "/p") $> ShowProfile
@@ -803,6 +822,8 @@ 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
+    fileName = safeDecodeUtf8 <$> A.takeTill (== ' ')
     memberRole =
       (" owner" $> GROwner)
         <|> (" admin" $> GRAdmin)

diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs
@@ -33,6 +33,7 @@ data ChatDirection (p :: AParty) where
   SentDirectMessage :: Contact -> ChatDirection 'Client
   ReceivedGroupMessage :: Connection -> GroupName -> GroupMember -> ChatDirection 'Agent
   SentGroupMessage :: GroupName -> ChatDirection 'Client
+  ReceivedFileChunk :: Connection -> FileTransfer -> ChatDirection 'Agent
 
 deriving instance Eq (ChatDirection p)
 
@@ -42,6 +43,7 @@ fromConnection :: ChatDirection 'Agent -> Connection
 fromConnection = \case
   ReceivedDirectMessage conn _ -> conn
   ReceivedGroupMessage conn _ _ -> conn
+  ReceivedFileChunk conn _ -> conn
 
 data ChatMsgEvent
   = XMsgNew MsgContent

diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs
@@ -314,7 +314,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.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
@@ -344,7 +344,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.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
@@ -356,22 +356,23 @@ 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, 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 UTCTime)
 
 toConnection :: ConnectionRow -> Connection
-toConnection (connId, agentConnId, connLevel, viaContact, connStatus, connType, contactId, groupMemberId, createdAt) =
+toConnection (connId, agentConnId, connLevel, viaContact, connStatus, connType, contactId, groupMemberId, fileId, 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_ ConnFile = fileId
 
 toMaybeConnection :: MaybeConnectionRow -> Maybe Connection
-toMaybeConnection (Just connId, Just agentConnId, Just connLevel, viaContact, Just connStatus, Just connType, contactId, groupMemberId, Just createdAt) =
-  Just $ toConnection (connId, agentConnId, connLevel, viaContact, connStatus, connType, contactId, groupMemberId, createdAt)
+toMaybeConnection (Just connId, Just agentConnId, Just connLevel, viaContact, Just connStatus, Just connType, contactId, groupMemberId, fileId, Just createdAt) =
+  Just $ toConnection (connId, agentConnId, connLevel, viaContact, connStatus, connType, contactId, groupMemberId, fileId, createdAt)
 toMaybeConnection _ = Nothing
 
 getMatchingContacts :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> m [Contact]
@@ -507,6 +508,7 @@ getConnectionChatDirection st User {userId, userContactId} agentConnId =
         ReceivedDirectMessage c <$> case entityId of
           Nothing -> pure Nothing
           Just contactId -> Just <$> getContactRec_ db contactId c
+      ConnFile -> throwError $ SEInternal "TODO support files"
   where
     getConnection_ :: DB.Connection -> ExceptT StoreError IO Connection
     getConnection_ db = ExceptT $ do
@@ -515,7 +517,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, rcv_file_id, created_at
             FROM connections
             WHERE user_id = ? AND agent_conn_id = ?
           |]
@@ -638,7 +640,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.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 = (
@@ -994,7 +996,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.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
@@ -1024,7 +1026,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.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 = (

diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs
@@ -299,14 +299,20 @@ serializeMemberStatus = \case
   GSMemComplete -> "complete"
   GSMemCreator -> "creator"
 
+data FileTransfer = FileTransfer
+  { fileId :: Int64,
+    agentConnId :: ConnId
+  }
+  deriving (Eq, Show)
+
 data Connection = Connection
   { connId :: Int64,
     agentConnId :: ConnId,
     connLevel :: Int,
     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 +359,7 @@ serializeConnStatus = \case
   ConnReady -> "ready"
   ConnDeleted -> "deleted"
 
-data ConnType = ConnContact | ConnMember
+data ConnType = ConnContact | ConnMember | ConnFile
   deriving (Eq, Show)
 
 instance FromField ConnType where fromField = fromTextField_ connTypeT
@@ -364,12 +370,14 @@ connTypeT :: Text -> Maybe ConnType
 connTypeT = \case
   "contact" -> Just ConnContact
   "member" -> Just ConnMember
+  "file" -> Just ConnFile
   _ -> Nothing
 
 serializeConnType :: ConnType -> Text
 serializeConnType = \case
   ConnContact -> "contact"
   ConnMember -> "member"
+  ConnFile -> "file"
 
 data NewConnection = NewConnection
   { agentConnId :: ByteString,

diff --git a/src/Simplex/Chat/protocol.md b/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