core: types to support xftp (#1971)

* core: types to support xftp * migration, amend types * update protocol / types * update protocol, types * update schema, simplexmq
2026-10-22 15:22:07 +00:00 · 2023-03-09 11:01:22 +00:00
1 parent 5f587c2104
commit 2817306659
@@ -54,7 +54,7 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfTknStatus)
 import Simplex.Messaging.Parsers (dropPrefix, enumJSON, parseAll, parseString, sumTypeJSON)
-import Simplex.Messaging.Protocol (AProtocolType, CorrId, MsgFlags, NtfServer, QueueId)
+import Simplex.Messaging.Protocol (AProtocolType, CorrId, MsgFlags, NtfServer, ProtocolType (..), QueueId, XFTPServerWithAuth)
 import Simplex.Messaging.TMap (TMap)
 import Simplex.Messaging.Transport (simplexMQVersion)
 import Simplex.Messaging.Transport.Client (TransportHost)
@@ -116,6 +116,7 @@ data ChatConfig = ChatConfig
 data DefaultAgentServers = DefaultAgentServers
  { smp :: NonEmpty SMPServerWithAuth,
    ntf :: [NtfServer],
+    xftp :: NonEmpty XFTPServerWithAuth,
    netCfg :: NetworkConfig
  }

@@ -245,6 +246,10 @@ data ChatCommand
  | GetUserSMPServers
  | APISetUserSMPServers UserId SMPServersConfig
  | SetUserSMPServers SMPServersConfig
+  | APIGetUserServers UserId
+  | GetUserServers
+  | APISetUserServers UserId ServersConfig
+  | SetUserServers ServersConfig
  | APITestSMPServer UserId SMPServerWithAuth
  | TestSMPServer SMPServerWithAuth
  | APISetChatItemTTL UserId (Maybe Int64)
@@ -332,6 +337,7 @@ data ChatCommand
  | SendImage ChatName FilePath
  | ForwardFile ChatName FileTransferId
  | ForwardImage ChatName FileTransferId
+  | SendFileDescription ChatName FilePath
  | ReceiveFile {fileId :: FileTransferId, fileInline :: Maybe Bool, filePath :: Maybe FilePath}
  | CancelFile FileTransferId
  | FileStatus FileTransferId
@@ -364,7 +370,7 @@ data ChatResponse
  | CRChatItems {user :: User, chatItems :: [AChatItem]}
  | CRChatItemId User (Maybe ChatItemId)
  | CRApiParsedMarkdown {formattedText :: Maybe MarkdownList}
-  | CRUserSMPServers {user :: User, smpServers :: NonEmpty ServerCfg, presetSMPServers :: NonEmpty SMPServerWithAuth}
+  | CRUserSMPServers {user :: User, smpServers :: NonEmpty (ServerCfg 'PSMP), presetSMPServers :: NonEmpty SMPServerWithAuth}
  | CRSmpTestResult {user :: User, smpTestFailure :: Maybe SMPTestFailure}
  | CRChatItemTTL {user :: User, chatItemTTL :: Maybe Int64}
  | CRNetworkConfig {networkConfig :: NetworkConfig}
@@ -527,7 +533,10 @@ instance ToJSON AgentQueueId where
  toJSON = strToJSON
  toEncoding = strToJEncoding

-data SMPServersConfig = SMPServersConfig {smpServers :: [ServerCfg]}
+data SMPServersConfig = SMPServersConfig {smpServers :: [ServerCfg 'PSMP]}
+  deriving (Show, Generic, FromJSON)
+
+data ServersConfig = ServersConfig {servers :: [AServerCfg]}
  deriving (Show, Generic, FromJSON)

 data ArchiveConfig = ArchiveConfig {archivePath :: FilePath, disableCompression :: Maybe Bool, parentTempDirectory :: Maybe FilePath}
@@ -0,0 +1,29 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Chat.Migrations.M20230304_file_description where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+-- this table includes file descriptions for the recipients for both sent and received files
+-- in the latter case the user is the recipient
+
+m20230304_file_description :: Query
+m20230304_file_description =
+  [sql|
+CREATE TABLE recipient_file_descriptions (
+  file_descr_id INTEGER PRIMARY KEY AUTOINCREMENT,
+  file_descr_size INTEGER NOT NULL,
+  file_descr_status TEXT NOT NULL,
+  file_descr_text TEXT NOT NULL
+);
+
+ALTER TABLE rcv_files ADD COLUMN file_descr_id INTEGER NULL
+  REFERENCES recipient_file_descriptions(file_descr_id) ON DELETE RESTRICT;
+
+ALTER TABLE snd_files ADD COLUMN file_descr_id INTEGER NULL
+  REFERENCES recipient_file_descriptions(file_descr_id) ON DELETE RESTRICT;
+
+ -- this is a private file description allowing to delete the file from the server
+ALTER TABLE files ADD COLUMN snd_file_descr_text TEXT NULL;
+|]
@@ -42,7 +42,7 @@ import Simplex.Chat.Call
 import Simplex.Chat.Types
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Parsers (fromTextField_, fstToLower, parseAll, sumTypeJSON)
+import Simplex.Messaging.Parsers (dropPrefix, fromTextField_, fstToLower, parseAll, sumTypeJSON, taggedObjectJSON)
 import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, (<$?>))

 data ConnectionEntity
@@ -179,6 +179,8 @@ instance StrEncoding AChatMessage where

 data ChatMsgEvent (e :: MsgEncoding) where
  XMsgNew :: MsgContainer -> ChatMsgEvent 'Json
+  XMsgFileDescr :: {msgId :: SharedMsgId, fileDescr :: FileDescr} -> ChatMsgEvent 'Json
+  XMsgFileCancel :: SharedMsgId -> ChatMsgEvent 'Json
  XMsgUpdate :: {msgId :: SharedMsgId, content :: MsgContent, ttl :: Maybe Int, live :: Maybe Bool} -> ChatMsgEvent 'Json
  XMsgDel :: SharedMsgId -> Maybe MemberId -> ChatMsgEvent 'Json
  XMsgDeleted :: ChatMsgEvent 'Json
@@ -264,7 +266,7 @@ cmToQuotedMsg = \case
  ACME _ (XMsgNew (MCQuote quotedMsg _)) -> Just quotedMsg
  _ -> Nothing

-data MsgContentTag = MCText_ | MCLink_ | MCImage_ | MCVoice_ | MCFile_ | MCUnknown_ Text
+data MsgContentTag = MCText_ | MCLink_ | MCImage_ | MCVideo_ | MCVoice_ | MCFile_ | MCUnknown_ Text
  deriving (Eq)

 instance StrEncoding MsgContentTag where
@@ -272,6 +274,7 @@ instance StrEncoding MsgContentTag where
    MCText_ -> "text"
    MCLink_ -> "link"
    MCImage_ -> "image"
+    MCVideo_ -> "video"
    MCFile_ -> "file"
    MCVoice_ -> "voice"
    MCUnknown_ t -> encodeUtf8 t
@@ -279,6 +282,7 @@ instance StrEncoding MsgContentTag where
    "text" -> Right MCText_
    "link" -> Right MCLink_
    "image" -> Right MCImage_
+    "video" -> Right MCVideo_
    "voice" -> Right MCVoice_
    "file" -> Right MCFile_
    t -> Right . MCUnknown_ $ safeDecodeUtf8 t
@@ -303,7 +307,10 @@ mcExtMsgContent = \case
  MCQuote _ c -> c
  MCForward c -> c

-data LinkPreview = LinkPreview {uri :: Text, title :: Text, description :: Text, image :: ImageData}
+data LinkPreview = LinkPreview {uri :: Text, title :: Text, description :: Text, image :: ImageData, content :: Maybe LinkContent}
+  deriving (Eq, Show, Generic)
+
+data LinkContent = LCPage | LCImage | LCVideo {duration :: Maybe Int} | LCUnknown {tag :: Text, json :: J.Object}
  deriving (Eq, Show, Generic)

 instance FromJSON LinkPreview where
@@ -313,10 +320,26 @@ instance ToJSON LinkPreview where
  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}

+instance FromJSON LinkContent where
+  parseJSON v@(J.Object j) =
+    J.genericParseJSON (taggedObjectJSON $ dropPrefix "LC") v
+      <|> LCUnknown <$> j .: "type" <*> pure j
+  parseJSON invalid =
+    JT.prependFailure "bad LinkContent, " (JT.typeMismatch "Object" invalid)
+
+instance ToJSON LinkContent where
+  toJSON = \case
+    LCUnknown _ j -> J.Object j
+    v -> J.genericToJSON (taggedObjectJSON $ dropPrefix "LC") v
+  toEncoding = \case
+    LCUnknown _ j -> JE.value $ J.Object j
+    v -> J.genericToEncoding (taggedObjectJSON $ dropPrefix "LC") v
+
 data MsgContent
  = MCText Text
  | MCLink {text :: Text, preview :: LinkPreview}
  | MCImage {text :: Text, image :: ImageData}
+  | MCVideo {text :: Text, image :: ImageData, duration :: Int}
  | MCVoice {text :: Text, duration :: Int}
  | MCFile Text
  | MCUnknown {tag :: Text, text :: Text, json :: J.Object}
@@ -327,6 +350,7 @@ msgContentText = \case
  MCText t -> t
  MCLink {text} -> text
  MCImage {text} -> text
+  MCVideo {text} -> text
  MCVoice {text, duration} ->
    if T.null text then msg else msg <> "; " <> text
    where
@@ -352,6 +376,7 @@ msgContentTag = \case
  MCText _ -> MCText_
  MCLink {} -> MCLink_
  MCImage {} -> MCImage_
+  MCVideo {} -> MCVideo_
  MCVoice {} -> MCVoice_
  MCFile {} -> MCFile_
  MCUnknown {tag} -> MCUnknown_ tag
@@ -385,7 +410,12 @@ instance FromJSON MsgContent where
      MCImage_ -> do
        text <- v .: "text"
        image <- v .: "image"
-        pure MCImage {image, text}
+        pure MCImage {text, image}
+      MCVideo_ -> do
+        text <- v .: "text"
+        image <- v .: "image"
+        duration <- v .: "duration"
+        pure MCVideo {text, image, duration}
      MCVoice_ -> do
        text <- v .: "text"
        duration <- v .: "duration"
@@ -415,6 +445,7 @@ instance ToJSON MsgContent where
    MCText t -> J.object ["type" .= MCText_, "text" .= t]
    MCLink {text, preview} -> J.object ["type" .= MCLink_, "text" .= text, "preview" .= preview]
    MCImage {text, image} -> J.object ["type" .= MCImage_, "text" .= text, "image" .= image]
+    MCVideo {text, image, duration} -> J.object ["type" .= MCImage_, "text" .= text, "image" .= image, "duration" .= duration]
    MCVoice {text, duration} -> J.object ["type" .= MCVoice_, "text" .= text, "duration" .= duration]
    MCFile t -> J.object ["type" .= MCFile_, "text" .= t]
  toEncoding = \case
@@ -422,6 +453,7 @@ instance ToJSON MsgContent where
    MCText t -> J.pairs $ "type" .= MCText_ <> "text" .= t
    MCLink {text, preview} -> J.pairs $ "type" .= MCLink_ <> "text" .= text <> "preview" .= preview
    MCImage {text, image} -> J.pairs $ "type" .= MCImage_ <> "text" .= text <> "image" .= image
+    MCVideo {text, image, duration} -> J.pairs $ "type" .= MCImage_ <> "text" .= text <> "image" .= image <> "duration" .= duration
    MCVoice {text, duration} -> J.pairs $ "type" .= MCVoice_ <> "text" .= text <> "duration" .= duration
    MCFile t -> J.pairs $ "type" .= MCFile_ <> "text" .= t

@@ -433,6 +465,8 @@ instance FromField MsgContent where

 data CMEventTag (e :: MsgEncoding) where
  XMsgNew_ :: CMEventTag 'Json
+  XMsgFileDescr_ :: CMEventTag 'Json
+  XMsgFileCancel_ :: CMEventTag 'Json
  XMsgUpdate_ :: CMEventTag 'Json
  XMsgDel_ :: CMEventTag 'Json
  XMsgDeleted_ :: CMEventTag 'Json
@@ -475,6 +509,8 @@ deriving instance Eq (CMEventTag e)
 instance MsgEncodingI e => StrEncoding (CMEventTag e) where
  strEncode = \case
    XMsgNew_ -> "x.msg.new"
+    XMsgFileDescr_ -> "x.msg.file.descr"
+    XMsgFileCancel_ -> "x.msg.file.cancel"
    XMsgUpdate_ -> "x.msg.update"
    XMsgDel_ -> "x.msg.del"
    XMsgDeleted_ -> "x.msg.deleted"
@@ -518,6 +554,8 @@ instance StrEncoding ACMEventTag where
    ((,) <$> A.peekChar' <*> A.takeTill (== ' ')) >>= \case
      ('x', t) -> pure . ACMEventTag SJson $ case t of
        "x.msg.new" -> XMsgNew_
+        "x.msg.file.descr" -> XMsgFileDescr_
+        "x.msg.file.cancel" -> XMsgFileCancel_
        "x.msg.update" -> XMsgUpdate_
        "x.msg.del" -> XMsgDel_
        "x.msg.deleted" -> XMsgDeleted_
@@ -557,6 +595,8 @@ instance StrEncoding ACMEventTag where
 toCMEventTag :: ChatMsgEvent e -> CMEventTag e
 toCMEventTag msg = case msg of
  XMsgNew _ -> XMsgNew_
+  XMsgFileDescr _ _ -> XMsgFileDescr_
+  XMsgFileCancel _ -> XMsgFileCancel_
  XMsgUpdate {} -> XMsgUpdate_
  XMsgDel {} -> XMsgDel_
  XMsgDeleted -> XMsgDeleted_
@@ -642,6 +682,8 @@ appJsonToCM AppMessageJson {msgId, event, params} = do
    msg :: CMEventTag 'Json -> Either String (ChatMsgEvent 'Json)
    msg = \case
      XMsgNew_ -> XMsgNew <$> JT.parseEither parseMsgContainer params
+      XMsgFileDescr_ -> XMsgFileDescr <$> p "msgId" <*> p "fileDescr"
+      XMsgFileCancel_ -> XMsgFileCancel <$> p "msgId"
      XMsgUpdate_ -> XMsgUpdate <$> p "msgId" <*> p "content" <*> opt "ttl" <*> opt "live"
      XMsgDel_ -> XMsgDel <$> p "msgId" <*> opt "memberId"
      XMsgDeleted_ -> pure XMsgDeleted
@@ -695,6 +737,8 @@ chatToAppMessage ChatMessage {msgId, chatMsgEvent} = case encoding @e of
    params :: ChatMsgEvent 'Json -> J.Object
    params = \case
      XMsgNew container -> msgContainerJSON container
+      XMsgFileDescr msgId' fileDescr -> o ["msgId" .= msgId', "fileDescr" .= fileDescr]
+      XMsgFileCancel msgId' -> o ["msgId" .= msgId']
      XMsgUpdate msgId' content ttl live -> o $ ("ttl" .=? ttl) $ ("live" .=? live) ["msgId" .= msgId', "content" .= content]
      XMsgDel msgId' memberId -> o $ ("memberId" .=? memberId) ["msgId" .= msgId']
      XMsgDeleted -> JM.empty
@@ -232,6 +232,8 @@ module Simplex.Chat.Store
    setGroupChatItemDeleteAt,
    getSMPServers,
    overwriteSMPServers,
+    getProtocolServers,
+    overwriteProtocolServers,
    createCall,
    deleteCalls,
    getCalls,
@@ -343,6 +345,7 @@ import Simplex.Chat.Migrations.M20230118_recreate_smp_servers
 import Simplex.Chat.Migrations.M20230129_drop_chat_items_group_idx
 import Simplex.Chat.Migrations.M20230206_item_deleted_by_group_member_id
 import Simplex.Chat.Migrations.M20230303_group_link_role
+-- import Simplex.Chat.Migrations.M20230304_file_description
 import Simplex.Chat.Protocol
 import Simplex.Chat.Types
 import Simplex.Chat.Util (week)
@@ -351,7 +354,7 @@ import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore (..), createSQLiteStore
 import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON)
-import Simplex.Messaging.Protocol (BasicAuth (..), ProtoServerWithAuth (..), ProtocolServer (..), pattern SMPServer)
+import Simplex.Messaging.Protocol (BasicAuth (..), ProtoServerWithAuth (..), ProtocolServer (..), ProtocolType (..), ProtocolTypeI (..), SProtocolType (..), pattern SMPServer)
 import Simplex.Messaging.Transport.Client (TransportHost)
 import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8)
 import UnliftIO.STM
@@ -410,6 +413,7 @@ schemaMigrations =
    ("20230129_drop_chat_items_group_idx", m20230129_drop_chat_items_group_idx),
    ("20230206_item_deleted_by_group_member_id", m20230206_item_deleted_by_group_member_id),
    ("20230303_group_link_role", m20230303_group_link_role)
+    -- ("20230304_file_description", m20230304_file_description)
  ]

 -- | The list of migrations in ascending order by date
@@ -2852,7 +2856,7 @@ createRcvFileTransfer db userId Contact {contactId, localDisplayName = c} f@File
    db
    "INSERT INTO rcv_files (file_id, file_status, file_queue_info, file_inline, rcv_file_inline, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
    (fileId, FSNew, fileConnReq, fileInline, rcvFileInline, currentTs, currentTs)
-  pure RcvFileTransfer {fileId, fileInvitation = f, fileStatus = RFSNew, rcvFileInline, senderDisplayName = c, chunkSize, cancelled = False, grpMemberId = Nothing}
+  pure RcvFileTransfer {fileId, fileInvitation = f, fileStatus = RFSNew, rcvFileInline, rcvFileDescription = Nothing, senderDisplayName = c, chunkSize, cancelled = False, grpMemberId = Nothing}

 createRcvGroupFileTransfer :: DB.Connection -> UserId -> GroupMember -> FileInvitation -> Maybe InlineFileMode -> Integer -> IO RcvFileTransfer
 createRcvGroupFileTransfer db userId GroupMember {groupId, groupMemberId, localDisplayName = c} f@FileInvitation {fileName, fileSize, fileConnReq, fileInline} rcvFileInline chunkSize = do
@@ -2866,7 +2870,7 @@ createRcvGroupFileTransfer db userId GroupMember {groupId, groupMemberId, localD
    db
    "INSERT INTO rcv_files (file_id, file_status, file_queue_info, file_inline, rcv_file_inline, group_member_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
    (fileId, FSNew, fileConnReq, fileInline, rcvFileInline, groupMemberId, currentTs, currentTs)
-  pure RcvFileTransfer {fileId, fileInvitation = f, fileStatus = RFSNew, rcvFileInline, senderDisplayName = c, chunkSize, cancelled = False, grpMemberId = Just groupMemberId}
+  pure RcvFileTransfer {fileId, fileInvitation = f, fileStatus = RFSNew, rcvFileInline, rcvFileDescription = Nothing, senderDisplayName = c, chunkSize, cancelled = False, grpMemberId = Just groupMemberId}

 getRcvFileTransferById :: DB.Connection -> FileTransferId -> ExceptT StoreError IO (User, RcvFileTransfer)
 getRcvFileTransferById db fileId = do
@@ -2897,7 +2901,7 @@ getRcvFileTransfer db User {userId} fileId = do
      (FileStatus, Maybe ConnReqInvitation, Maybe Int64, String, Integer, Integer, Maybe Bool) :. (Maybe ContactName, Maybe ContactName, Maybe FilePath, Maybe InlineFileMode, Maybe InlineFileMode) :. (Maybe Int64, Maybe AgentConnId) ->
      ExceptT StoreError IO RcvFileTransfer
    rcvFileTransfer ((fileStatus', fileConnReq, grpMemberId, fileName, fileSize, chunkSize, cancelled_) :. (contactName_, memberName_, filePath_, fileInline, rcvFileInline) :. (connId_, agentConnId_)) = do
-      let fileInv = FileInvitation {fileName, fileSize, fileConnReq, fileInline}
+      let fileInv = FileInvitation {fileName, fileSize, fileDigest = Nothing, fileConnReq, fileInline, fileDescr = Nothing}
          fileInfo = (filePath_, connId_, agentConnId_)
      case contactName_ <|> memberName_ of
        Nothing -> throwError $ SERcvFileInvalid fileId
@@ -2910,7 +2914,7 @@ getRcvFileTransfer db User {userId} fileId = do
            FSCancelled -> ft name fileInv . RFSCancelled <$> rfi_ fileInfo
      where
        ft senderDisplayName fileInvitation fileStatus =
-          RcvFileTransfer {fileId, fileInvitation, fileStatus, rcvFileInline, senderDisplayName, chunkSize, cancelled, grpMemberId}
+          RcvFileTransfer {fileId, fileInvitation, fileStatus, rcvFileInline, rcvFileDescription = Nothing, senderDisplayName, chunkSize, cancelled, grpMemberId}
        rfi fileInfo = maybe (throwError $ SERcvFileInvalid fileId) pure =<< rfi_ fileInfo
        rfi_ = \case
          (Just filePath, connId, agentConnId) -> pure $ Just RcvFileInfo {filePath, connId, agentConnId}
@@ -4615,7 +4619,7 @@ toGroupChatItemList tz currentTs userContactId (((Just itemId, Just itemTs, Just
  either (const []) (: []) $ toGroupChatItem tz currentTs userContactId (((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_)
 toGroupChatItemList _ _ _ _ = []

-getSMPServers :: DB.Connection -> User -> IO [ServerCfg]
+getSMPServers :: DB.Connection -> User -> IO [ServerCfg 'PSMP]
 getSMPServers db User {userId} =
  map toServerCfg
    <$> DB.query
@@ -4627,12 +4631,12 @@ getSMPServers db User {userId} =
      |]
      (Only userId)
  where
-    toServerCfg :: (NonEmpty TransportHost, String, C.KeyHash, Maybe Text, Bool, Maybe Bool, Bool) -> ServerCfg
+    toServerCfg :: (NonEmpty TransportHost, String, C.KeyHash, Maybe Text, Bool, Maybe Bool, Bool) -> ServerCfg 'PSMP
    toServerCfg (host, port, keyHash, auth_, preset, tested, enabled) =
      let server = ProtoServerWithAuth (SMPServer host port keyHash) (BasicAuth . encodeUtf8 <$> auth_)
       in ServerCfg {server, preset, tested, enabled}

-overwriteSMPServers :: DB.Connection -> User -> [ServerCfg] -> ExceptT StoreError IO ()
+overwriteSMPServers :: DB.Connection -> User -> [ServerCfg 'PSMP] -> ExceptT StoreError IO ()
 overwriteSMPServers db User {userId} servers =
  checkConstraint SEUniqueID . ExceptT $ do
    currentTs <- getCurrentTime
@@ -4649,6 +4653,16 @@ overwriteSMPServers db User {userId} servers =
        (host, port, keyHash, safeDecodeUtf8 . unBasicAuth <$> auth_, preset, tested, enabled, userId, currentTs, currentTs)
    pure $ Right ()

+getProtocolServers :: forall p. ProtocolTypeI p => DB.Connection -> User -> IO [ServerCfg p]
+getProtocolServers db user = case protocolTypeI @p of
+  SPSMP -> getSMPServers db user
+  _ -> pure [] -- TODO read from the new table of all servers (alternatively, we could migrate data)
+
+overwriteProtocolServers :: forall p. ProtocolTypeI p => DB.Connection -> User -> [ServerCfg p] -> ExceptT StoreError IO ()
+overwriteProtocolServers db user servers = case protocolTypeI @p of
+  SPSMP -> overwriteSMPServers db user servers
+  _ -> pure () -- TODO write the new table of all servers
+
 createCall :: DB.Connection -> User -> Call -> UTCTime -> IO ()
 createCall db user@User {userId} Call {contactId, callId, chatItemId, callState} callTs = do
  currentTs <- getCurrentTime
@@ -17,6 +17,7 @@ import Simplex.Chat.Options
 import Simplex.Chat.Terminal.Input
 import Simplex.Chat.Terminal.Notification
 import Simplex.Chat.Terminal.Output
+import Simplex.FileTransfer.Client.Presets (defaultXFTPServers)
 import Simplex.Messaging.Client (defaultNetworkConfig)
 import Simplex.Messaging.Util (raceAny_)
 import System.Exit (exitFailure)
@@ -33,6 +34,7 @@ terminalChatConfig =
                  "smp://PQUV2eL0t7OStZOoAsPEV2QYWt4-xilbakvGUGOItUo=@smp6.simplex.im,bylepyau3ty4czmn77q4fglvperknl4bi2eb2fdy2bh4jxtf32kf73yd.onion"
                ],
            ntf = ["ntf://FB-Uop7RTaZZEG0ZLD2CIaTjsPh-Fw0zFAnb7QyA8Ks=@ntf2.simplex.im,ntg7jdjy2i3qbib3sykiho3enekwiaqg3icctliqhtqcg6jmoh6cxiad.onion"],
+            xftp = defaultXFTPServers,
            netCfg = defaultNetworkConfig
          }
    }
@@ -1,3 +1,4 @@
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -26,7 +26,7 @@ module Simplex.Chat.Types where

 import Control.Applicative ((<|>))
 import Crypto.Number.Serialize (os2ip)
-import Data.Aeson (FromJSON, ToJSON)
+import Data.Aeson (FromJSON (..), ToJSON (..))
 import qualified Data.Aeson as J
 import qualified Data.Aeson.Encoding as JE
 import qualified Data.Aeson.Types as JT
@@ -48,10 +48,11 @@ import Database.SQLite.Simple.Ok (Ok (Ok))
 import Database.SQLite.Simple.ToField (ToField (..))
 import GHC.Generics (Generic)
 import GHC.Records.Compat
+import Simplex.FileTransfer.Description (FileDigest)
 import Simplex.Messaging.Agent.Protocol (ACommandTag (..), ACorrId, AParty (..), ConnId, ConnectionMode (..), ConnectionRequestUri, InvitationId)
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (dropPrefix, enumJSON, fromTextField_, sumTypeJSON, taggedObjectJSON)
-import Simplex.Messaging.Protocol (SMPServerWithAuth)
+import Simplex.Messaging.Protocol (AProtoServerWithAuth, ProtoServerWithAuth, ProtocolTypeI)
 import Simplex.Messaging.Util (safeDecodeUtf8, (<$?>))

 class IsContact a where
@@ -1470,8 +1471,10 @@ type FileTransferId = Int64
 data FileInvitation = FileInvitation
  { fileName :: String,
    fileSize :: Integer,
+    fileDigest :: Maybe FileDigest,
    fileConnReq :: Maybe ConnReqInvitation,
-    fileInline :: Maybe InlineFileMode
+    fileInline :: Maybe InlineFileMode,
+    fileDescr :: Maybe FileDescr
  }
  deriving (Eq, Show, Generic)

@@ -1482,6 +1485,19 @@ instance ToJSON FileInvitation where
 instance FromJSON FileInvitation where
  parseJSON = J.genericParseJSON J.defaultOptions {J.omitNothingFields = True}

+data FileDescr
+  = FDText {fileDescrText :: Text}
+  | FDInline {fileDescrSize :: Integer, fileDescrInline :: InlineFileMode}
+  | FDPending
+  deriving (Eq, Show, Generic)
+
+instance ToJSON FileDescr where
+  toEncoding = J.genericToEncoding . taggedObjectJSON $ dropPrefix "FD"
+  toJSON = J.genericToJSON . taggedObjectJSON $ dropPrefix "FD"
+
+instance FromJSON FileDescr where
+  parseJSON = J.genericParseJSON . taggedObjectJSON $ dropPrefix "FD"
+
 data InlineFileMode
  = IFMOffer -- file will be sent inline once accepted
  | IFMSent -- file is sent inline without acceptance
@@ -1512,6 +1528,7 @@ data RcvFileTransfer = RcvFileTransfer
    fileInvitation :: FileInvitation,
    fileStatus :: RcvFileStatus,
    rcvFileInline :: Maybe InlineFileMode,
+    rcvFileDescription :: Maybe RcvFileDescr,
    senderDisplayName :: ContactName,
    chunkSize :: Integer,
    cancelled :: Bool,
@@ -1521,6 +1538,16 @@ data RcvFileTransfer = RcvFileTransfer

 instance ToJSON RcvFileTransfer where toEncoding = J.genericToEncoding J.defaultOptions

+data RcvFileDescr = RcvFileDescr
+  { fileDescrId :: Int64,
+    fileDescrStatus :: RcvFileStatus,
+    fileDescrText :: Text,
+    chunkSize :: Integer
+  }
+  deriving (Eq, Show, Generic)
+
+instance ToJSON RcvFileDescr where toEncoding = J.genericToEncoding J.defaultOptions
+
 data RcvFileStatus
  = RFSNew
  | RFSAccepted RcvFileInfo
@@ -1947,17 +1974,35 @@ encodeJSON = safeDecodeUtf8 . LB.toStrict . J.encode
 decodeJSON :: FromJSON a => Text -> Maybe a
 decodeJSON = J.decode . LB.fromStrict . encodeUtf8

-data ServerCfg = ServerCfg
-  { server :: SMPServerWithAuth,
+data ServerCfg p = ServerCfg
+  { server :: ProtoServerWithAuth p,
    preset :: Bool,
    tested :: Maybe Bool,
    enabled :: Bool
  }
  deriving (Show, Generic)

-instance ToJSON ServerCfg where
+instance ProtocolTypeI p => ToJSON (ServerCfg p) where
  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}

-instance FromJSON ServerCfg where
+instance ProtocolTypeI p => FromJSON (ServerCfg p) where
+  parseJSON = J.genericParseJSON J.defaultOptions {J.omitNothingFields = True}
+
+data AServerCfg = AServerCfg
+  { server :: AProtoServerWithAuth,
+    preset :: Bool,
+    tested :: Maybe Bool,
+    enabled :: Bool
+  }
+
+deriving instance Show AServerCfg
+
+deriving instance Generic AServerCfg
+
+instance ToJSON AServerCfg where
+  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
+
+instance FromJSON AServerCfg where
  parseJSON = J.genericParseJSON J.defaultOptions {J.omitNothingFields = True}
@@ -45,7 +45,7 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (dropPrefix, taggedObjectJSON)
-import Simplex.Messaging.Protocol (AProtocolType, ProtocolServer (..))
+import Simplex.Messaging.Protocol (AProtocolType, ProtocolServer (..), ProtocolTypeI)
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Util (bshow, tshow)
@@ -721,12 +721,13 @@ viewUserProfile Profile {displayName, fullName} =
    "(the updated profile will be sent to all your contacts)"
  ]

-viewSMPServers :: [ServerCfg] -> Bool -> [StyledString]
-viewSMPServers smpServers testView =
+-- TODO make more generic messages or split
+viewSMPServers :: ProtocolTypeI p => [ServerCfg p] -> Bool -> [StyledString]
+viewSMPServers servers testView =
  if testView
-    then [customSMPServers]
+    then [customServers]
    else
-      [ customSMPServers,
+      [ customServers,
        "",
        "use " <> highlight' "/smp test <srv>" <> " to test SMP server connection",
        "use " <> highlight' "/smp set <srv1[,srv2,...]>" <> " to switch to custom SMP servers",
@@ -734,10 +735,10 @@ viewSMPServers smpServers testView =
        "(chat option " <> highlight' "-s" <> " (" <> highlight' "--server" <> ") has precedence over saved SMP servers for chat session)"
      ]
  where
-    customSMPServers =
-      if null smpServers
+    customServers =
+      if null servers
        then "no custom SMP servers saved"
-        else viewServers smpServers
+        else viewServers servers

 viewSMPTestResult :: Maybe SMPTestFailure -> [StyledString]
 viewSMPTestResult = \case
@@ -798,7 +799,7 @@ viewConnectionStats ConnectionStats {rcvServers, sndServers} =
  ["receiving messages via: " <> viewServerHosts rcvServers | not $ null rcvServers]
    <> ["sending messages via: " <> viewServerHosts sndServers | not $ null sndServers]

-viewServers :: [ServerCfg] -> StyledString
+viewServers :: ProtocolTypeI p => [ServerCfg p] -> StyledString
 viewServers = plain . intercalate ", " . map (B.unpack . strEncode . (\ServerCfg {server} -> server))

 viewServerHosts :: [SMPServer] -> StyledString