{-# LANGUAGE CPP #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}

module Simplex.Chat.Store.Files
  ( createSndDirectInlineFT,
    createSndGroupInlineFT,
    updateSndDirectFTDelivery,
    updateSndGroupFTDelivery,
    getSndFTViaMsgDelivery,
    createSndFileTransferXFTP,
    createSndFTDescrXFTP,
    setSndFTPrivateSndDescr,
    updateSndFTDescrXFTP,
    createExtraSndFTDescrs,
    updateSndFTDeliveryXFTP,
    setSndFTAgentDeleted,
    getXFTPSndFileDBIds,
    getXFTPRcvFileDBIds,
    updateFileCancelled,
    updateCIFileStatus,
    getSharedMsgIdByFileId,
    getFileIdBySharedMsgId,
    getGroupFileIdBySharedMsgId,
    getDirectFileIdBySharedMsgId,
    getChatRefByFileId,
    lookupChatRefByFileId,
    updateSndFileStatus,
    createRcvFileTransfer,
    createRcvGroupFileTransfer,
    createRcvStandaloneFileTransfer,
    appendRcvFD,
    getRcvFileDescrByRcvFileId,
    getRcvFileDescrBySndFileId,
    updateRcvFileAgentId,
    getRcvFileTransferById,
    getRcvFileTransfer,
    acceptRcvInlineFT,
    startRcvInlineFT,
    xftpAcceptRcvFT,
    setRcvFileToReceive,
    setFileCryptoArgs,
    removeFileCryptoArgs,
    getRcvFilesToReceive,
    setRcvFTAgentDeleted,
    updateRcvFileStatus,
    createRcvFileChunk,
    updatedRcvFileChunkStored,
    deleteRcvFileChunks,
    updateFileTransferChatItemId,
    getFileTransfer,
    getFileTransferProgress,
    getFileTransferMeta,
    lookupFileTransferRedirectMeta,
    getSndFileTransfer,
    getContactFileInfo,
    getNoteFolderFileInfo,
    createLocalFile,
    getLocalCryptoFile,
    updateDirectCIFileStatus,
  )
where

import Control.Applicative ((<|>))
import Control.Monad
import Control.Monad.Except
import Control.Monad.IO.Class
import Data.Either (rights)
import Data.Functor ((<&>))
import Data.Int (Int64)
import Data.Maybe (fromMaybe, isJust, listToMaybe)
import Data.Text (Text)
import Data.Time (addUTCTime)
import Data.Time.Clock (UTCTime (..), getCurrentTime, nominalDay)
import Data.Type.Equality
import Data.Word (Word32)
import Simplex.Chat.Messages
import Simplex.Chat.Messages.CIContent
import Simplex.Chat.Store.Messages
import Simplex.Chat.Store.Profiles
import Simplex.Chat.Store.Shared
import Simplex.Chat.Types
import Simplex.Messaging.Agent.Protocol (AgentMsgId, UserId)
import Simplex.Messaging.Agent.Store.AgentStore (firstRow, firstRow', maybeFirstRow)
import Simplex.Messaging.Agent.Store.DB (BoolInt (..))
import qualified Simplex.Messaging.Agent.Store.DB as DB
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
import qualified Simplex.Messaging.Crypto.File as CF
import System.FilePath (takeFileName)
#if defined(dbPostgres)
import Database.PostgreSQL.Simple (Only (..), (:.) (..))
import Database.PostgreSQL.Simple.SqlQQ (sql)
import Database.PostgreSQL.Simple.ToField (ToField)
#else
import Database.SQLite.Simple (Only (..), (:.) (..))
import Database.SQLite.Simple.QQ (sql)
import Database.SQLite.Simple.ToField (ToField)
#endif

createSndDirectInlineFT :: DB.Connection -> Contact -> FileTransferMeta -> ExceptT StoreError IO SndFileTransfer
createSndDirectInlineFT :: Connection
-> Contact
-> FileTransferMeta
-> ExceptT StoreError IO SndFileTransfer
createSndDirectInlineFT Connection
_ Contact {Text
localDisplayName :: Text
localDisplayName :: Contact -> Text
localDisplayName, activeConn :: Contact -> Maybe Connection
activeConn = Maybe Connection
Nothing} FileTransferMeta
_ = StoreError -> ExceptT StoreError IO SndFileTransfer
forall a. StoreError -> ExceptT StoreError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (StoreError -> ExceptT StoreError IO SndFileTransfer)
-> StoreError -> ExceptT StoreError IO SndFileTransfer
forall a b. (a -> b) -> a -> b
$ Text -> StoreError
SEContactNotReady Text
localDisplayName
createSndDirectInlineFT Connection
db Contact {localDisplayName :: Contact -> Text
localDisplayName = Text
n, activeConn :: Contact -> Maybe Connection
activeConn = Just Connection {UserId
connId :: UserId
connId :: Connection -> UserId
connId, AgentConnId
agentConnId :: AgentConnId
agentConnId :: Connection -> AgentConnId
agentConnId}} FileTransferMeta {UserId
fileId :: UserId
fileId :: FileTransferMeta -> UserId
fileId, FilePath
fileName :: FilePath
fileName :: FileTransferMeta -> FilePath
fileName, FilePath
filePath :: FilePath
filePath :: FileTransferMeta -> FilePath
filePath, Integer
fileSize :: Integer
fileSize :: FileTransferMeta -> Integer
fileSize, Integer
chunkSize :: Integer
chunkSize :: FileTransferMeta -> Integer
chunkSize, Maybe InlineFileMode
fileInline :: Maybe InlineFileMode
fileInline :: FileTransferMeta -> Maybe InlineFileMode
fileInline} = IO SndFileTransfer -> ExceptT StoreError IO SndFileTransfer
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SndFileTransfer -> ExceptT StoreError IO SndFileTransfer)
-> IO SndFileTransfer -> ExceptT StoreError IO SndFileTransfer
forall a b. (a -> b) -> a -> b
$ do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  let fileStatus :: FileStatus
fileStatus = FileStatus
FSConnected
      fileInline' :: Maybe InlineFileMode
fileInline' = InlineFileMode -> Maybe InlineFileMode
forall a. a -> Maybe a
Just (InlineFileMode -> Maybe InlineFileMode)
-> InlineFileMode -> Maybe InlineFileMode
forall a b. (a -> b) -> a -> b
$ InlineFileMode -> Maybe InlineFileMode -> InlineFileMode
forall a. a -> Maybe a -> a
fromMaybe InlineFileMode
IFMOffer Maybe InlineFileMode
fileInline
  Connection
-> Query
-> (UserId, FileStatus, Maybe InlineFileMode, UserId, UTCTime,
    UTCTime)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    Query
"INSERT INTO snd_files (file_id, file_status, file_inline, connection_id, created_at, updated_at) VALUES (?,?,?,?,?,?)"
    (UserId
fileId, FileStatus
fileStatus, Maybe InlineFileMode
fileInline', UserId
connId, UTCTime
currentTs, UTCTime
currentTs)
  SndFileTransfer -> IO SndFileTransfer
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SndFileTransfer {UserId
fileId :: UserId
fileId :: UserId
fileId, FilePath
fileName :: FilePath
fileName :: FilePath
fileName, FilePath
filePath :: FilePath
filePath :: FilePath
filePath, Integer
fileSize :: Integer
fileSize :: Integer
fileSize, Integer
chunkSize :: Integer
chunkSize :: Integer
chunkSize, recipientDisplayName :: Text
recipientDisplayName = Text
n, UserId
connId :: UserId
connId :: UserId
connId, AgentConnId
agentConnId :: AgentConnId
agentConnId :: AgentConnId
agentConnId, groupMemberId :: Maybe UserId
groupMemberId = Maybe UserId
forall a. Maybe a
Nothing, FileStatus
fileStatus :: FileStatus
fileStatus :: FileStatus
fileStatus, fileDescrId :: Maybe UserId
fileDescrId = Maybe UserId
forall a. Maybe a
Nothing, fileInline :: Maybe InlineFileMode
fileInline = Maybe InlineFileMode
fileInline'}

createSndGroupInlineFT :: DB.Connection -> GroupMember -> Connection -> FileTransferMeta -> IO SndFileTransfer
createSndGroupInlineFT :: Connection
-> GroupMember
-> Connection
-> FileTransferMeta
-> IO SndFileTransfer
createSndGroupInlineFT Connection
db GroupMember {UserId
groupMemberId :: UserId
groupMemberId :: GroupMember -> UserId
groupMemberId, localDisplayName :: GroupMember -> Text
localDisplayName = Text
n} Connection {UserId
connId :: Connection -> UserId
connId :: UserId
connId, AgentConnId
agentConnId :: Connection -> AgentConnId
agentConnId :: AgentConnId
agentConnId} FileTransferMeta {UserId
fileId :: FileTransferMeta -> UserId
fileId :: UserId
fileId, FilePath
fileName :: FileTransferMeta -> FilePath
fileName :: FilePath
fileName, FilePath
filePath :: FileTransferMeta -> FilePath
filePath :: FilePath
filePath, Integer
fileSize :: FileTransferMeta -> Integer
fileSize :: Integer
fileSize, Integer
chunkSize :: FileTransferMeta -> Integer
chunkSize :: Integer
chunkSize, Maybe InlineFileMode
fileInline :: FileTransferMeta -> Maybe InlineFileMode
fileInline :: Maybe InlineFileMode
fileInline} = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  let fileStatus :: FileStatus
fileStatus = FileStatus
FSConnected
      fileInline' :: Maybe InlineFileMode
fileInline' = InlineFileMode -> Maybe InlineFileMode
forall a. a -> Maybe a
Just (InlineFileMode -> Maybe InlineFileMode)
-> InlineFileMode -> Maybe InlineFileMode
forall a b. (a -> b) -> a -> b
$ InlineFileMode -> Maybe InlineFileMode -> InlineFileMode
forall a. a -> Maybe a -> a
fromMaybe InlineFileMode
IFMOffer Maybe InlineFileMode
fileInline
  Connection
-> Query
-> (UserId, FileStatus, Maybe InlineFileMode, UserId, UserId,
    UTCTime, UTCTime)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    Query
"INSERT INTO snd_files (file_id, file_status, file_inline, connection_id, group_member_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
    (UserId
fileId, FileStatus
fileStatus, Maybe InlineFileMode
fileInline', UserId
connId, UserId
groupMemberId, UTCTime
currentTs, UTCTime
currentTs)
  SndFileTransfer -> IO SndFileTransfer
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SndFileTransfer {UserId
fileId :: UserId
fileId :: UserId
fileId, FilePath
fileName :: FilePath
fileName :: FilePath
fileName, FilePath
filePath :: FilePath
filePath :: FilePath
filePath, Integer
fileSize :: Integer
fileSize :: Integer
fileSize, Integer
chunkSize :: Integer
chunkSize :: Integer
chunkSize, recipientDisplayName :: Text
recipientDisplayName = Text
n, UserId
connId :: UserId
connId :: UserId
connId, AgentConnId
agentConnId :: AgentConnId
agentConnId :: AgentConnId
agentConnId, groupMemberId :: Maybe UserId
groupMemberId = UserId -> Maybe UserId
forall a. a -> Maybe a
Just UserId
groupMemberId, FileStatus
fileStatus :: FileStatus
fileStatus :: FileStatus
fileStatus, fileDescrId :: Maybe UserId
fileDescrId = Maybe UserId
forall a. Maybe a
Nothing, fileInline :: Maybe InlineFileMode
fileInline = Maybe InlineFileMode
fileInline'}

updateSndDirectFTDelivery :: DB.Connection -> Contact -> FileTransferMeta -> Int64 -> ExceptT StoreError IO ()
updateSndDirectFTDelivery :: Connection
-> Contact
-> FileTransferMeta
-> UserId
-> ExceptT StoreError IO ()
updateSndDirectFTDelivery Connection
_ Contact {Text
localDisplayName :: Contact -> Text
localDisplayName :: Text
localDisplayName, activeConn :: Contact -> Maybe Connection
activeConn = Maybe Connection
Nothing} FileTransferMeta
_ UserId
_ = StoreError -> ExceptT StoreError IO ()
forall a. StoreError -> ExceptT StoreError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (StoreError -> ExceptT StoreError IO ())
-> StoreError -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ Text -> StoreError
SEContactNotReady Text
localDisplayName
updateSndDirectFTDelivery Connection
db Contact {activeConn :: Contact -> Maybe Connection
activeConn = Just Connection {UserId
connId :: Connection -> UserId
connId :: UserId
connId}} FileTransferMeta {UserId
fileId :: FileTransferMeta -> UserId
fileId :: UserId
fileId} UserId
msgDeliveryId =
  IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$
    Connection -> Query -> (UserId, UserId, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
      Connection
db
      Query
"UPDATE snd_files SET last_inline_msg_delivery_id = ? WHERE connection_id = ? AND file_id = ? AND file_inline IS NOT NULL"
      (UserId
msgDeliveryId, UserId
connId, UserId
fileId)

updateSndGroupFTDelivery :: DB.Connection -> GroupMember -> Connection -> FileTransferMeta -> Int64 -> IO ()
updateSndGroupFTDelivery :: Connection
-> GroupMember -> Connection -> FileTransferMeta -> UserId -> IO ()
updateSndGroupFTDelivery Connection
db GroupMember {UserId
groupMemberId :: GroupMember -> UserId
groupMemberId :: UserId
groupMemberId} Connection {UserId
connId :: Connection -> UserId
connId :: UserId
connId} FileTransferMeta {UserId
fileId :: FileTransferMeta -> UserId
fileId :: UserId
fileId} UserId
msgDeliveryId =
  Connection -> Query -> (UserId, UserId, UserId, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    Query
"UPDATE snd_files SET last_inline_msg_delivery_id = ? WHERE group_member_id = ? AND connection_id = ? AND file_id = ? AND file_inline IS NOT NULL"
    (UserId
msgDeliveryId, UserId
groupMemberId, UserId
connId, UserId
fileId)

getSndFTViaMsgDelivery :: DB.Connection -> User -> Connection -> AgentMsgId -> IO (Maybe SndFileTransfer)
getSndFTViaMsgDelivery :: Connection
-> User -> Connection -> UserId -> IO (Maybe SndFileTransfer)
getSndFTViaMsgDelivery Connection
db User {UserId
userId :: UserId
userId :: User -> UserId
userId} Connection {UserId
connId :: Connection -> UserId
connId :: UserId
connId, AgentConnId
agentConnId :: Connection -> AgentConnId
agentConnId :: AgentConnId
agentConnId} UserId
agentMsgId = do
  ((UserId, FileStatus, FilePath, Integer, Integer, FilePath,
 Maybe UserId, Maybe InlineFileMode, Maybe UserId, Maybe Text,
 Maybe Text)
-> Maybe SndFileTransfer
sndFileTransfer_ ((UserId, FileStatus, FilePath, Integer, Integer, FilePath,
  Maybe UserId, Maybe InlineFileMode, Maybe UserId, Maybe Text,
  Maybe Text)
 -> Maybe SndFileTransfer)
-> ([(UserId, FileStatus, FilePath, Integer, Integer, FilePath,
      Maybe UserId, Maybe InlineFileMode, Maybe UserId, Maybe Text,
      Maybe Text)]
    -> Maybe
         (UserId, FileStatus, FilePath, Integer, Integer, FilePath,
          Maybe UserId, Maybe InlineFileMode, Maybe UserId, Maybe Text,
          Maybe Text))
-> [(UserId, FileStatus, FilePath, Integer, Integer, FilePath,
     Maybe UserId, Maybe InlineFileMode, Maybe UserId, Maybe Text,
     Maybe Text)]
-> Maybe SndFileTransfer
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< [(UserId, FileStatus, FilePath, Integer, Integer, FilePath,
  Maybe UserId, Maybe InlineFileMode, Maybe UserId, Maybe Text,
  Maybe Text)]
-> Maybe
     (UserId, FileStatus, FilePath, Integer, Integer, FilePath,
      Maybe UserId, Maybe InlineFileMode, Maybe UserId, Maybe Text,
      Maybe Text)
forall a. [a] -> Maybe a
listToMaybe)
    ([(UserId, FileStatus, FilePath, Integer, Integer, FilePath,
   Maybe UserId, Maybe InlineFileMode, Maybe UserId, Maybe Text,
   Maybe Text)]
 -> Maybe SndFileTransfer)
-> IO
     [(UserId, FileStatus, FilePath, Integer, Integer, FilePath,
       Maybe UserId, Maybe InlineFileMode, Maybe UserId, Maybe Text,
       Maybe Text)]
-> IO (Maybe SndFileTransfer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (UserId, UserId, UserId)
-> IO
     [(UserId, FileStatus, FilePath, Integer, Integer, FilePath,
       Maybe UserId, Maybe InlineFileMode, Maybe UserId, Maybe Text,
       Maybe Text)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT s.file_id, s.file_status, f.file_name, f.file_size, f.chunk_size, f.file_path, s.file_descr_id, s.file_inline, s.group_member_id, c.local_display_name, m.local_display_name
        FROM msg_deliveries d
        JOIN snd_files s ON s.connection_id = d.connection_id AND s.last_inline_msg_delivery_id = d.msg_delivery_id
        JOIN files f ON f.file_id = s.file_id
        LEFT JOIN contacts c USING (contact_id)
        LEFT JOIN group_members m USING (group_member_id)
        WHERE d.connection_id = ? AND d.agent_msg_id = ? AND f.user_id = ?
          AND (s.file_descr_id IS NOT NULL OR s.file_inline IS NOT NULL)
      |]
      (UserId
connId, UserId
agentMsgId, UserId
userId)
  where
    sndFileTransfer_ :: (Int64, FileStatus, String, Integer, Integer, FilePath, Maybe Int64, Maybe InlineFileMode, Maybe Int64, Maybe ContactName, Maybe ContactName) -> Maybe SndFileTransfer
    sndFileTransfer_ :: (UserId, FileStatus, FilePath, Integer, Integer, FilePath,
 Maybe UserId, Maybe InlineFileMode, Maybe UserId, Maybe Text,
 Maybe Text)
-> Maybe SndFileTransfer
sndFileTransfer_ (UserId
fileId, FileStatus
fileStatus, FilePath
fileName, Integer
fileSize, Integer
chunkSize, FilePath
filePath, Maybe UserId
fileDescrId, Maybe InlineFileMode
fileInline, Maybe UserId
groupMemberId, Maybe Text
contactName_, Maybe Text
memberName_) =
      (\Text
n -> SndFileTransfer {UserId
fileId :: UserId
fileId :: UserId
fileId, FileStatus
fileStatus :: FileStatus
fileStatus :: FileStatus
fileStatus, FilePath
fileName :: FilePath
fileName :: FilePath
fileName, Integer
fileSize :: Integer
fileSize :: Integer
fileSize, Integer
chunkSize :: Integer
chunkSize :: Integer
chunkSize, FilePath
filePath :: FilePath
filePath :: FilePath
filePath, Maybe UserId
fileDescrId :: Maybe UserId
fileDescrId :: Maybe UserId
fileDescrId, Maybe InlineFileMode
fileInline :: Maybe InlineFileMode
fileInline :: Maybe InlineFileMode
fileInline, Maybe UserId
groupMemberId :: Maybe UserId
groupMemberId :: Maybe UserId
groupMemberId, recipientDisplayName :: Text
recipientDisplayName = Text
n, UserId
connId :: UserId
connId :: UserId
connId, AgentConnId
agentConnId :: AgentConnId
agentConnId :: AgentConnId
agentConnId})
        (Text -> SndFileTransfer) -> Maybe Text -> Maybe SndFileTransfer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe Text
contactName_ Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
memberName_)

createSndFileTransferXFTP :: DB.Connection -> User -> Maybe ContactOrGroup -> CryptoFile -> FileInvitation -> AgentSndFileId -> Maybe FileTransferId -> Integer -> IO FileTransferMeta
createSndFileTransferXFTP :: Connection
-> User
-> Maybe ContactOrGroup
-> CryptoFile
-> FileInvitation
-> AgentSndFileId
-> Maybe UserId
-> Integer
-> IO FileTransferMeta
createSndFileTransferXFTP Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} Maybe ContactOrGroup
contactOrGroup_ (CryptoFile FilePath
filePath Maybe CryptoFileArgs
cryptoArgs) FileInvitation {FilePath
fileName :: FilePath
fileName :: FileInvitation -> FilePath
fileName, Integer
fileSize :: Integer
fileSize :: FileInvitation -> Integer
fileSize} AgentSndFileId
agentSndFileId Maybe UserId
xftpRedirectFor Integer
chunkSize = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  let xftpSndFile :: Maybe XFTPSndFile
xftpSndFile = XFTPSndFile -> Maybe XFTPSndFile
forall a. a -> Maybe a
Just XFTPSndFile {AgentSndFileId
agentSndFileId :: AgentSndFileId
agentSndFileId :: AgentSndFileId
agentSndFileId, privateSndFileDescr :: Maybe Text
privateSndFileDescr = Maybe Text
forall a. Maybe a
Nothing, agentSndFileDeleted :: Bool
agentSndFileDeleted = Bool
False, Maybe CryptoFileArgs
cryptoArgs :: Maybe CryptoFileArgs
cryptoArgs :: Maybe CryptoFileArgs
cryptoArgs}
  Connection
-> Query
-> ((Maybe UserId, Maybe UserId)
    :. ((UserId, FilePath, FilePath, Maybe SbKey, Maybe CbNonce,
         Integer, Integer)
        :. (Maybe UserId, AgentSndFileId, CIFileStatus 'MDSnd,
            FileProtocol, UTCTime, UTCTime)))
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    Query
"INSERT INTO files (contact_id, group_id, user_id, file_name, file_path, file_crypto_key, file_crypto_nonce, file_size, chunk_size, redirect_file_id, agent_snd_file_id, ci_file_status, protocol, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
    ((Maybe UserId, Maybe UserId)
-> (ContactOrGroup -> (Maybe UserId, Maybe UserId))
-> Maybe ContactOrGroup
-> (Maybe UserId, Maybe UserId)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe UserId
forall a. Maybe a
Nothing, Maybe UserId
forall a. Maybe a
Nothing) ContactOrGroup -> (Maybe UserId, Maybe UserId)
contactAndGroupIds Maybe ContactOrGroup
contactOrGroup_ (Maybe UserId, Maybe UserId)
-> ((UserId, FilePath, FilePath, Maybe SbKey, Maybe CbNonce,
     Integer, Integer)
    :. (Maybe UserId, AgentSndFileId, CIFileStatus 'MDSnd,
        FileProtocol, UTCTime, UTCTime))
-> (Maybe UserId, Maybe UserId)
   :. ((UserId, FilePath, FilePath, Maybe SbKey, Maybe CbNonce,
        Integer, Integer)
       :. (Maybe UserId, AgentSndFileId, CIFileStatus 'MDSnd,
           FileProtocol, UTCTime, UTCTime))
forall h t. h -> t -> h :. t
:. (UserId
userId, FilePath
fileName, FilePath
filePath, CryptoFileArgs -> SbKey
CF.fileKey (CryptoFileArgs -> SbKey) -> Maybe CryptoFileArgs -> Maybe SbKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CryptoFileArgs
cryptoArgs, CryptoFileArgs -> CbNonce
CF.fileNonce (CryptoFileArgs -> CbNonce)
-> Maybe CryptoFileArgs -> Maybe CbNonce
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CryptoFileArgs
cryptoArgs, Integer
fileSize, Integer
chunkSize) (UserId, FilePath, FilePath, Maybe SbKey, Maybe CbNonce, Integer,
 Integer)
-> (Maybe UserId, AgentSndFileId, CIFileStatus 'MDSnd,
    FileProtocol, UTCTime, UTCTime)
-> (UserId, FilePath, FilePath, Maybe SbKey, Maybe CbNonce,
    Integer, Integer)
   :. (Maybe UserId, AgentSndFileId, CIFileStatus 'MDSnd,
       FileProtocol, UTCTime, UTCTime)
forall h t. h -> t -> h :. t
:. (Maybe UserId
xftpRedirectFor, AgentSndFileId
agentSndFileId, CIFileStatus 'MDSnd
CIFSSndStored, FileProtocol
FPXFTP, UTCTime
currentTs, UTCTime
currentTs))
  UserId
fileId <- Connection -> IO UserId
insertedRowId Connection
db
  FileTransferMeta -> IO FileTransferMeta
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileTransferMeta {UserId
fileId :: UserId
fileId :: UserId
fileId, Maybe XFTPSndFile
xftpSndFile :: Maybe XFTPSndFile
xftpSndFile :: Maybe XFTPSndFile
xftpSndFile, Maybe UserId
xftpRedirectFor :: Maybe UserId
xftpRedirectFor :: Maybe UserId
xftpRedirectFor, FilePath
fileName :: FilePath
fileName :: FilePath
fileName, FilePath
filePath :: FilePath
filePath :: FilePath
filePath, Integer
fileSize :: Integer
fileSize :: Integer
fileSize, fileInline :: Maybe InlineFileMode
fileInline = Maybe InlineFileMode
forall a. Maybe a
Nothing, Integer
chunkSize :: Integer
chunkSize :: Integer
chunkSize, cancelled :: Bool
cancelled = Bool
False}

createSndFTDescrXFTP :: DB.Connection -> User -> Maybe GroupMember -> Connection -> FileTransferMeta -> FileDescr -> IO ()
createSndFTDescrXFTP :: Connection
-> User
-> Maybe GroupMember
-> Connection
-> FileTransferMeta
-> FileDescr
-> IO ()
createSndFTDescrXFTP Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} Maybe GroupMember
m Connection {UserId
connId :: Connection -> UserId
connId :: UserId
connId} FileTransferMeta {UserId
fileId :: FileTransferMeta -> UserId
fileId :: UserId
fileId} FileDescr {Text
fileDescrText :: Text
fileDescrText :: FileDescr -> Text
fileDescrText, Int
fileDescrPartNo :: Int
fileDescrPartNo :: FileDescr -> Int
fileDescrPartNo, Bool
fileDescrComplete :: Bool
fileDescrComplete :: FileDescr -> Bool
fileDescrComplete} = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  let fileStatus :: FileStatus
fileStatus = FileStatus
FSNew
  Connection
-> Query -> (UserId, Text, Int, BoolInt, UTCTime, UTCTime) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    Query
"INSERT INTO xftp_file_descriptions (user_id, file_descr_text, file_descr_part_no, file_descr_complete, created_at, updated_at) VALUES (?,?,?,?,?,?)"
    (UserId
userId, Text
fileDescrText, Int
fileDescrPartNo, Bool -> BoolInt
BI Bool
fileDescrComplete, UTCTime
currentTs, UTCTime
currentTs)
  UserId
fileDescrId <- Connection -> IO UserId
insertedRowId Connection
db
  Connection
-> Query
-> (UserId, FileStatus, UserId, Maybe UserId, UserId, UTCTime,
    UTCTime)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    Query
"INSERT INTO snd_files (file_id, file_status, file_descr_id, group_member_id, connection_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
    (UserId
fileId, FileStatus
fileStatus, UserId
fileDescrId, GroupMember -> UserId
groupMemberId' (GroupMember -> UserId) -> Maybe GroupMember -> Maybe UserId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe GroupMember
m, UserId
connId, UTCTime
currentTs, UTCTime
currentTs)

setSndFTPrivateSndDescr :: DB.Connection -> User -> FileTransferId -> Text -> IO ()
setSndFTPrivateSndDescr :: Connection -> User -> UserId -> Text -> IO ()
setSndFTPrivateSndDescr Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} UserId
fileId Text
sfdText = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  Connection -> Query -> (Text, UTCTime, UserId, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    Query
"UPDATE files SET private_snd_file_descr = ?, updated_at = ? WHERE user_id = ? AND file_id = ?"
    (Text
sfdText, UTCTime
currentTs, UserId
userId, UserId
fileId)

updateSndFTDescrXFTP :: DB.Connection -> User -> SndFileTransfer -> Text -> IO ()
updateSndFTDescrXFTP :: Connection -> User -> SndFileTransfer -> Text -> IO ()
updateSndFTDescrXFTP Connection
db user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId} sft :: SndFileTransfer
sft@SndFileTransfer {UserId
fileId :: SndFileTransfer -> UserId
fileId :: UserId
fileId, Maybe UserId
fileDescrId :: SndFileTransfer -> Maybe UserId
fileDescrId :: Maybe UserId
fileDescrId} Text
rfdText = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  Connection
-> Query
-> (Text, Int, BoolInt, UTCTime, UserId, Maybe UserId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE xftp_file_descriptions
      SET file_descr_text = ?, file_descr_part_no = ?, file_descr_complete = ?, updated_at = ?
      WHERE user_id = ? AND file_descr_id = ?
    |]
    (Text
rfdText, Int
1 :: Int, Bool -> BoolInt
BI Bool
True, UTCTime
currentTs, UserId
userId, Maybe UserId
fileDescrId)
  Connection -> User -> UserId -> CIFileStatus 'MDSnd -> IO ()
forall (d :: MsgDirection).
MsgDirectionI d =>
Connection -> User -> UserId -> CIFileStatus d -> IO ()
updateCIFileStatus Connection
db User
user UserId
fileId (CIFileStatus 'MDSnd -> IO ()) -> CIFileStatus 'MDSnd -> IO ()
forall a b. (a -> b) -> a -> b
$ UserId -> UserId -> CIFileStatus 'MDSnd
CIFSSndTransfer UserId
1 UserId
1
  Connection -> SndFileTransfer -> FileStatus -> IO ()
updateSndFileStatus Connection
db SndFileTransfer
sft FileStatus
FSConnected

createExtraSndFTDescrs :: DB.Connection -> User -> FileTransferId -> [Text] -> IO ()
createExtraSndFTDescrs :: Connection -> User -> UserId -> [Text] -> IO ()
createExtraSndFTDescrs Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} UserId
fileId [Text]
rfdTexts = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  [Text] -> (Text -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Text]
rfdTexts ((Text -> IO ()) -> IO ()) -> (Text -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Text
rfdText ->
    Connection
-> Query -> (UserId, UserId, Text, UTCTime, UTCTime) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
      Connection
db
      Query
"INSERT INTO extra_xftp_file_descriptions (file_id, user_id, file_descr_text, created_at, updated_at) VALUES (?,?,?,?,?)"
      (UserId
fileId, UserId
userId, Text
rfdText, UTCTime
currentTs, UTCTime
currentTs)

updateSndFTDeliveryXFTP :: DB.Connection -> SndFileTransfer -> Int64 -> IO ()
updateSndFTDeliveryXFTP :: Connection -> SndFileTransfer -> UserId -> IO ()
updateSndFTDeliveryXFTP Connection
db SndFileTransfer {UserId
connId :: SndFileTransfer -> UserId
connId :: UserId
connId, UserId
fileId :: SndFileTransfer -> UserId
fileId :: UserId
fileId, Maybe UserId
fileDescrId :: SndFileTransfer -> Maybe UserId
fileDescrId :: Maybe UserId
fileDescrId} UserId
msgDeliveryId =
  Connection
-> Query -> (UserId, UserId, UserId, Maybe UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    Query
"UPDATE snd_files SET last_inline_msg_delivery_id = ? WHERE connection_id = ? AND file_id = ? AND file_descr_id = ?"
    (UserId
msgDeliveryId, UserId
connId, UserId
fileId, Maybe UserId
fileDescrId)

setSndFTAgentDeleted :: DB.Connection -> User -> FileTransferId -> IO ()
setSndFTAgentDeleted :: Connection -> User -> UserId -> IO ()
setSndFTAgentDeleted Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} UserId
fileId = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  Connection -> Query -> (UTCTime, UserId, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    Query
"UPDATE files SET agent_snd_file_deleted = 1, updated_at = ? WHERE user_id = ? AND file_id = ?"
    (UTCTime
currentTs, UserId
userId, UserId
fileId)

getXFTPSndFileDBIds :: DB.Connection -> AgentSndFileId -> ExceptT StoreError IO (Maybe ChatRef, FileTransferId)
getXFTPSndFileDBIds :: Connection
-> AgentSndFileId -> ExceptT StoreError IO (Maybe ChatRef, UserId)
getXFTPSndFileDBIds Connection
db AgentSndFileId
aSndFileId =
  IO (Either StoreError (Maybe ChatRef, UserId))
-> ExceptT StoreError IO (Maybe ChatRef, UserId)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError (Maybe ChatRef, UserId))
 -> ExceptT StoreError IO (Maybe ChatRef, UserId))
-> (IO [(UserId, Maybe UserId, Maybe UserId, Maybe UserId)]
    -> IO (Either StoreError (Maybe ChatRef, UserId)))
-> IO [(UserId, Maybe UserId, Maybe UserId, Maybe UserId)]
-> ExceptT StoreError IO (Maybe ChatRef, UserId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((UserId, Maybe UserId, Maybe UserId, Maybe UserId)
 -> Either StoreError (Maybe ChatRef, UserId))
-> StoreError
-> IO [(UserId, Maybe UserId, Maybe UserId, Maybe UserId)]
-> IO (Either StoreError (Maybe ChatRef, UserId))
forall a e b. (a -> Either e b) -> e -> IO [a] -> IO (Either e b)
firstRow' (UserId, Maybe UserId, Maybe UserId, Maybe UserId)
-> Either StoreError (Maybe ChatRef, UserId)
toFileRef (AgentSndFileId -> StoreError
SESndFileNotFoundXFTP AgentSndFileId
aSndFileId) (IO [(UserId, Maybe UserId, Maybe UserId, Maybe UserId)]
 -> ExceptT StoreError IO (Maybe ChatRef, UserId))
-> IO [(UserId, Maybe UserId, Maybe UserId, Maybe UserId)]
-> ExceptT StoreError IO (Maybe ChatRef, UserId)
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> Only AgentSndFileId
-> IO [(UserId, Maybe UserId, Maybe UserId, Maybe UserId)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT file_id, contact_id, group_id, note_folder_id
        FROM files
        WHERE agent_snd_file_id = ?
      |]
      (AgentSndFileId -> Only AgentSndFileId
forall a. a -> Only a
Only AgentSndFileId
aSndFileId)

getXFTPRcvFileDBIds :: DB.Connection -> AgentRcvFileId -> ExceptT StoreError IO (Maybe ChatRef, FileTransferId)
getXFTPRcvFileDBIds :: Connection
-> AgentRcvFileId -> ExceptT StoreError IO (Maybe ChatRef, UserId)
getXFTPRcvFileDBIds Connection
db AgentRcvFileId
aRcvFileId =
  IO (Either StoreError (Maybe ChatRef, UserId))
-> ExceptT StoreError IO (Maybe ChatRef, UserId)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError (Maybe ChatRef, UserId))
 -> ExceptT StoreError IO (Maybe ChatRef, UserId))
-> (IO [(UserId, Maybe UserId, Maybe UserId, Maybe UserId)]
    -> IO (Either StoreError (Maybe ChatRef, UserId)))
-> IO [(UserId, Maybe UserId, Maybe UserId, Maybe UserId)]
-> ExceptT StoreError IO (Maybe ChatRef, UserId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((UserId, Maybe UserId, Maybe UserId, Maybe UserId)
 -> Either StoreError (Maybe ChatRef, UserId))
-> StoreError
-> IO [(UserId, Maybe UserId, Maybe UserId, Maybe UserId)]
-> IO (Either StoreError (Maybe ChatRef, UserId))
forall a e b. (a -> Either e b) -> e -> IO [a] -> IO (Either e b)
firstRow' (UserId, Maybe UserId, Maybe UserId, Maybe UserId)
-> Either StoreError (Maybe ChatRef, UserId)
toFileRef (AgentRcvFileId -> StoreError
SERcvFileNotFoundXFTP AgentRcvFileId
aRcvFileId) (IO [(UserId, Maybe UserId, Maybe UserId, Maybe UserId)]
 -> ExceptT StoreError IO (Maybe ChatRef, UserId))
-> IO [(UserId, Maybe UserId, Maybe UserId, Maybe UserId)]
-> ExceptT StoreError IO (Maybe ChatRef, UserId)
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> Only AgentRcvFileId
-> IO [(UserId, Maybe UserId, Maybe UserId, Maybe UserId)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT rf.file_id, f.contact_id, f.group_id, f.note_folder_id
        FROM rcv_files rf
        JOIN files f ON f.file_id = rf.file_id
        WHERE rf.agent_rcv_file_id = ?
      |]
      (AgentRcvFileId -> Only AgentRcvFileId
forall a. a -> Only a
Only AgentRcvFileId
aRcvFileId)

toFileRef :: (FileTransferId, Maybe Int64, Maybe Int64, Maybe Int64) -> Either StoreError (Maybe ChatRef, FileTransferId)
toFileRef :: (UserId, Maybe UserId, Maybe UserId, Maybe UserId)
-> Either StoreError (Maybe ChatRef, UserId)
toFileRef = \case
  (UserId
fileId, Just UserId
contactId, Maybe UserId
Nothing, Maybe UserId
Nothing) -> (Maybe ChatRef, UserId)
-> Either StoreError (Maybe ChatRef, UserId)
forall a b. b -> Either a b
Right (ChatRef -> Maybe ChatRef
forall a. a -> Maybe a
Just (ChatRef -> Maybe ChatRef) -> ChatRef -> Maybe ChatRef
forall a b. (a -> b) -> a -> b
$ ChatType -> UserId -> Maybe GroupChatScope -> ChatRef
ChatRef ChatType
CTDirect UserId
contactId Maybe GroupChatScope
forall a. Maybe a
Nothing, UserId
fileId)
  (UserId
fileId, Maybe UserId
Nothing, Just UserId
groupId, Maybe UserId
Nothing) -> (Maybe ChatRef, UserId)
-> Either StoreError (Maybe ChatRef, UserId)
forall a b. b -> Either a b
Right (ChatRef -> Maybe ChatRef
forall a. a -> Maybe a
Just (ChatRef -> Maybe ChatRef) -> ChatRef -> Maybe ChatRef
forall a b. (a -> b) -> a -> b
$ ChatType -> UserId -> Maybe GroupChatScope -> ChatRef
ChatRef ChatType
CTGroup UserId
groupId Maybe GroupChatScope
forall a. Maybe a
Nothing, UserId
fileId)
  (UserId
fileId, Maybe UserId
Nothing, Maybe UserId
Nothing, Just UserId
folderId) -> (Maybe ChatRef, UserId)
-> Either StoreError (Maybe ChatRef, UserId)
forall a b. b -> Either a b
Right (ChatRef -> Maybe ChatRef
forall a. a -> Maybe a
Just (ChatRef -> Maybe ChatRef) -> ChatRef -> Maybe ChatRef
forall a b. (a -> b) -> a -> b
$ ChatType -> UserId -> Maybe GroupChatScope -> ChatRef
ChatRef ChatType
CTLocal UserId
folderId Maybe GroupChatScope
forall a. Maybe a
Nothing, UserId
fileId)
  (UserId
fileId, Maybe UserId
_, Maybe UserId
_, Maybe UserId
_) -> (Maybe ChatRef, UserId)
-> Either StoreError (Maybe ChatRef, UserId)
forall a b. b -> Either a b
Right (Maybe ChatRef
forall a. Maybe a
Nothing, UserId
fileId)

updateFileCancelled :: MsgDirectionI d => DB.Connection -> User -> Int64 -> CIFileStatus d -> IO ()
updateFileCancelled :: forall (d :: MsgDirection).
MsgDirectionI d =>
Connection -> User -> UserId -> CIFileStatus d -> IO ()
updateFileCancelled Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} UserId
fileId CIFileStatus d
ciFileStatus = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  Connection
-> Query -> (CIFileStatus d, UTCTime, UserId, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE files SET cancelled = 1, ci_file_status = ?, updated_at = ? WHERE user_id = ? AND file_id = ?" (CIFileStatus d
ciFileStatus, UTCTime
currentTs, UserId
userId, UserId
fileId)

updateCIFileStatus :: MsgDirectionI d => DB.Connection -> User -> Int64 -> CIFileStatus d -> IO ()
updateCIFileStatus :: forall (d :: MsgDirection).
MsgDirectionI d =>
Connection -> User -> UserId -> CIFileStatus d -> IO ()
updateCIFileStatus Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} UserId
fileId CIFileStatus d
ciFileStatus = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  Connection
-> Query -> (CIFileStatus d, UTCTime, UserId, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE files SET ci_file_status = ?, updated_at = ? WHERE user_id = ? AND file_id = ?" (CIFileStatus d
ciFileStatus, UTCTime
currentTs, UserId
userId, UserId
fileId)

getSharedMsgIdByFileId :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO SharedMsgId
getSharedMsgIdByFileId :: Connection -> UserId -> UserId -> ExceptT StoreError IO SharedMsgId
getSharedMsgIdByFileId Connection
db UserId
userId UserId
fileId =
  IO (Either StoreError SharedMsgId)
-> ExceptT StoreError IO SharedMsgId
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError SharedMsgId)
 -> ExceptT StoreError IO SharedMsgId)
-> (IO [Only SharedMsgId] -> IO (Either StoreError SharedMsgId))
-> IO [Only SharedMsgId]
-> ExceptT StoreError IO SharedMsgId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Only SharedMsgId -> SharedMsgId)
-> StoreError
-> IO [Only SharedMsgId]
-> IO (Either StoreError SharedMsgId)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow Only SharedMsgId -> SharedMsgId
forall a. Only a -> a
fromOnly (UserId -> StoreError
SESharedMsgIdNotFoundByFileId UserId
fileId) (IO [Only SharedMsgId] -> ExceptT StoreError IO SharedMsgId)
-> IO [Only SharedMsgId] -> ExceptT StoreError IO SharedMsgId
forall a b. (a -> b) -> a -> b
$
    Connection -> Query -> (UserId, UserId) -> IO [Only SharedMsgId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT i.shared_msg_id
        FROM chat_items i
        JOIN files f ON f.chat_item_id = i.chat_item_id
        WHERE f.user_id = ? AND f.file_id = ?
      |]
      (UserId
userId, UserId
fileId)

getFileIdBySharedMsgId :: DB.Connection -> UserId -> Int64 -> SharedMsgId -> ExceptT StoreError IO Int64
getFileIdBySharedMsgId :: Connection
-> UserId -> UserId -> SharedMsgId -> ExceptT StoreError IO UserId
getFileIdBySharedMsgId Connection
db UserId
userId UserId
contactId SharedMsgId
sharedMsgId =
  IO (Either StoreError UserId) -> ExceptT StoreError IO UserId
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError UserId) -> ExceptT StoreError IO UserId)
-> (IO [Only UserId] -> IO (Either StoreError UserId))
-> IO [Only UserId]
-> ExceptT StoreError IO UserId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Only UserId -> UserId)
-> StoreError -> IO [Only UserId] -> IO (Either StoreError UserId)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow Only UserId -> UserId
forall a. Only a -> a
fromOnly (SharedMsgId -> StoreError
SEFileIdNotFoundBySharedMsgId SharedMsgId
sharedMsgId) (IO [Only UserId] -> ExceptT StoreError IO UserId)
-> IO [Only UserId] -> ExceptT StoreError IO UserId
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query -> (UserId, UserId, SharedMsgId) -> IO [Only UserId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT f.file_id
        FROM files f
        JOIN chat_items i ON i.chat_item_id = f.chat_item_id
        WHERE i.user_id = ? AND i.contact_id = ? AND i.shared_msg_id = ?
      |]
      (UserId
userId, UserId
contactId, SharedMsgId
sharedMsgId)

getGroupFileIdBySharedMsgId :: DB.Connection -> UserId -> Int64 -> SharedMsgId -> ExceptT StoreError IO Int64
getGroupFileIdBySharedMsgId :: Connection
-> UserId -> UserId -> SharedMsgId -> ExceptT StoreError IO UserId
getGroupFileIdBySharedMsgId Connection
db UserId
userId UserId
groupId SharedMsgId
sharedMsgId =
  IO (Either StoreError UserId) -> ExceptT StoreError IO UserId
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError UserId) -> ExceptT StoreError IO UserId)
-> (IO [Only UserId] -> IO (Either StoreError UserId))
-> IO [Only UserId]
-> ExceptT StoreError IO UserId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Only UserId -> UserId)
-> StoreError -> IO [Only UserId] -> IO (Either StoreError UserId)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow Only UserId -> UserId
forall a. Only a -> a
fromOnly (SharedMsgId -> StoreError
SEFileIdNotFoundBySharedMsgId SharedMsgId
sharedMsgId) (IO [Only UserId] -> ExceptT StoreError IO UserId)
-> IO [Only UserId] -> ExceptT StoreError IO UserId
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query -> (UserId, UserId, SharedMsgId) -> IO [Only UserId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT f.file_id
        FROM files f
        JOIN chat_items i ON i.chat_item_id = f.chat_item_id
        WHERE i.user_id = ? AND i.group_id = ? AND i.shared_msg_id = ?
      |]
      (UserId
userId, UserId
groupId, SharedMsgId
sharedMsgId)

getDirectFileIdBySharedMsgId :: DB.Connection -> User -> Contact -> SharedMsgId -> ExceptT StoreError IO Int64
getDirectFileIdBySharedMsgId :: Connection
-> User -> Contact -> SharedMsgId -> ExceptT StoreError IO UserId
getDirectFileIdBySharedMsgId Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} Contact {UserId
contactId :: UserId
contactId :: Contact -> UserId
contactId} SharedMsgId
sharedMsgId =
  IO (Either StoreError UserId) -> ExceptT StoreError IO UserId
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError UserId) -> ExceptT StoreError IO UserId)
-> (IO [Only UserId] -> IO (Either StoreError UserId))
-> IO [Only UserId]
-> ExceptT StoreError IO UserId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Only UserId -> UserId)
-> StoreError -> IO [Only UserId] -> IO (Either StoreError UserId)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow Only UserId -> UserId
forall a. Only a -> a
fromOnly (SharedMsgId -> StoreError
SEFileIdNotFoundBySharedMsgId SharedMsgId
sharedMsgId) (IO [Only UserId] -> ExceptT StoreError IO UserId)
-> IO [Only UserId] -> ExceptT StoreError IO UserId
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query -> (UserId, UserId, SharedMsgId) -> IO [Only UserId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT f.file_id
        FROM files f
        JOIN chat_items i ON i.chat_item_id = f.chat_item_id
        WHERE i.user_id = ? AND i.contact_id = ? AND i.shared_msg_id = ?
      |]
      (UserId
userId, UserId
contactId, SharedMsgId
sharedMsgId)

getChatRefByFileId :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO ChatRef
getChatRefByFileId :: Connection -> User -> UserId -> ExceptT StoreError IO ChatRef
getChatRefByFileId Connection
db User
user UserId
fileId = IO (Maybe ChatRef) -> ExceptT StoreError IO (Maybe ChatRef)
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Connection -> User -> UserId -> IO (Maybe ChatRef)
lookupChatRefByFileId Connection
db User
user UserId
fileId) ExceptT StoreError IO (Maybe ChatRef)
-> (Maybe ChatRef -> ExceptT StoreError IO ChatRef)
-> ExceptT StoreError IO ChatRef
forall a b.
ExceptT StoreError IO a
-> (a -> ExceptT StoreError IO b) -> ExceptT StoreError IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExceptT StoreError IO ChatRef
-> (ChatRef -> ExceptT StoreError IO ChatRef)
-> Maybe ChatRef
-> ExceptT StoreError IO ChatRef
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (StoreError -> ExceptT StoreError IO ChatRef
forall a. StoreError -> ExceptT StoreError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (StoreError -> ExceptT StoreError IO ChatRef)
-> StoreError -> ExceptT StoreError IO ChatRef
forall a b. (a -> b) -> a -> b
$ FilePath -> StoreError
SEInternalError FilePath
"could not retrieve chat ref by file id") ChatRef -> ExceptT StoreError IO ChatRef
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

lookupChatRefByFileId :: DB.Connection -> User -> Int64 -> IO (Maybe ChatRef)
lookupChatRefByFileId :: Connection -> User -> UserId -> IO (Maybe ChatRef)
lookupChatRefByFileId Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} UserId
fileId =
  IO [(Maybe UserId, Maybe UserId)]
getChatRef IO [(Maybe UserId, Maybe UserId)]
-> ([(Maybe UserId, Maybe UserId)] -> Maybe ChatRef)
-> IO (Maybe ChatRef)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
    [(Just UserId
contactId, Maybe UserId
Nothing)] -> ChatRef -> Maybe ChatRef
forall a. a -> Maybe a
Just (ChatRef -> Maybe ChatRef) -> ChatRef -> Maybe ChatRef
forall a b. (a -> b) -> a -> b
$ ChatType -> UserId -> Maybe GroupChatScope -> ChatRef
ChatRef ChatType
CTDirect UserId
contactId Maybe GroupChatScope
forall a. Maybe a
Nothing
    [(Maybe UserId
Nothing, Just UserId
groupId)] -> ChatRef -> Maybe ChatRef
forall a. a -> Maybe a
Just (ChatRef -> Maybe ChatRef) -> ChatRef -> Maybe ChatRef
forall a b. (a -> b) -> a -> b
$ ChatType -> UserId -> Maybe GroupChatScope -> ChatRef
ChatRef ChatType
CTGroup UserId
groupId Maybe GroupChatScope
forall a. Maybe a
Nothing
    [(Maybe UserId, Maybe UserId)]
_ -> Maybe ChatRef
forall a. Maybe a
Nothing
  where
    getChatRef :: IO [(Maybe UserId, Maybe UserId)]
getChatRef =
      Connection
-> Query -> (UserId, UserId) -> IO [(Maybe UserId, Maybe UserId)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
        Connection
db
        [sql|
          SELECT contact_id, group_id
          FROM files
          WHERE user_id = ? AND file_id = ?
          LIMIT 1
        |]
        (UserId
userId, UserId
fileId)

updateSndFileStatus :: DB.Connection -> SndFileTransfer -> FileStatus -> IO ()
updateSndFileStatus :: Connection -> SndFileTransfer -> FileStatus -> IO ()
updateSndFileStatus Connection
db SndFileTransfer {UserId
fileId :: SndFileTransfer -> UserId
fileId :: UserId
fileId, UserId
connId :: SndFileTransfer -> UserId
connId :: UserId
connId} FileStatus
status = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  Connection
-> Query -> (FileStatus, UTCTime, UserId, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE snd_files SET file_status = ?, updated_at = ? WHERE file_id = ? AND connection_id = ?" (FileStatus
status, UTCTime
currentTs, UserId
fileId, UserId
connId)

createRcvFileTransfer :: DB.Connection -> UserId -> Contact -> FileInvitation -> Maybe InlineFileMode -> Integer -> ExceptT StoreError IO RcvFileTransfer
createRcvFileTransfer :: Connection
-> UserId
-> Contact
-> FileInvitation
-> Maybe InlineFileMode
-> Integer
-> ExceptT StoreError IO RcvFileTransfer
createRcvFileTransfer Connection
db UserId
userId Contact {UserId
contactId :: Contact -> UserId
contactId :: UserId
contactId, localDisplayName :: Contact -> Text
localDisplayName = Text
c} f :: FileInvitation
f@FileInvitation {FilePath
fileName :: FileInvitation -> FilePath
fileName :: FilePath
fileName, Integer
fileSize :: FileInvitation -> Integer
fileSize :: Integer
fileSize, Maybe ConnReqInvitation
fileConnReq :: Maybe ConnReqInvitation
fileConnReq :: FileInvitation -> Maybe ConnReqInvitation
fileConnReq, Maybe InlineFileMode
fileInline :: Maybe InlineFileMode
fileInline :: FileInvitation -> Maybe InlineFileMode
fileInline, Maybe FileDescr
fileDescr :: Maybe FileDescr
fileDescr :: FileInvitation -> Maybe FileDescr
fileDescr} Maybe InlineFileMode
rcvFileInline Integer
chunkSize = do
  UTCTime
currentTs <- IO UTCTime -> ExceptT StoreError IO UTCTime
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  Maybe RcvFileDescr
rfd_ <- (FileDescr -> ExceptT StoreError IO RcvFileDescr)
-> Maybe FileDescr -> ExceptT StoreError IO (Maybe RcvFileDescr)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (Connection
-> UserId
-> UTCTime
-> FileDescr
-> ExceptT StoreError IO RcvFileDescr
createRcvFD_ Connection
db UserId
userId UTCTime
currentTs) Maybe FileDescr
fileDescr
  let rfdId :: Maybe UserId
rfdId = (\RcvFileDescr {UserId
fileDescrId :: UserId
fileDescrId :: RcvFileDescr -> UserId
fileDescrId} -> UserId
fileDescrId) (RcvFileDescr -> UserId) -> Maybe RcvFileDescr -> Maybe UserId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RcvFileDescr
rfd_
      -- cryptoArgs = Nothing here, the decision to encrypt is made when receiving it
      xftpRcvFile :: Maybe XFTPRcvFile
xftpRcvFile = (\RcvFileDescr
rfd -> XFTPRcvFile {rcvFileDescription :: RcvFileDescr
rcvFileDescription = RcvFileDescr
rfd, agentRcvFileId :: Maybe AgentRcvFileId
agentRcvFileId = Maybe AgentRcvFileId
forall a. Maybe a
Nothing, agentRcvFileDeleted :: Bool
agentRcvFileDeleted = Bool
False, userApprovedRelays :: Bool
userApprovedRelays = Bool
False}) (RcvFileDescr -> XFTPRcvFile)
-> Maybe RcvFileDescr -> Maybe XFTPRcvFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RcvFileDescr
rfd_
      fileProtocol :: FileProtocol
fileProtocol = if Maybe RcvFileDescr -> Bool
forall a. Maybe a -> Bool
isJust Maybe RcvFileDescr
rfd_ then FileProtocol
FPXFTP else FileProtocol
FPSMP
  UserId
fileId <- IO UserId -> ExceptT StoreError IO UserId
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UserId -> ExceptT StoreError IO UserId)
-> IO UserId -> ExceptT StoreError IO UserId
forall a b. (a -> b) -> a -> b
$ do
    Connection
-> Query
-> (UserId, UserId, FilePath, Integer, Integer,
    Maybe InlineFileMode, CIFileStatus 'MDRcv, FileProtocol, UTCTime,
    UTCTime)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
      Connection
db
      Query
"INSERT INTO files (user_id, contact_id, file_name, file_size, chunk_size, file_inline, ci_file_status, protocol, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?)"
      (UserId
userId, UserId
contactId, FilePath
fileName, Integer
fileSize, Integer
chunkSize, Maybe InlineFileMode
fileInline, CIFileStatus 'MDRcv
CIFSRcvInvitation, FileProtocol
fileProtocol, UTCTime
currentTs, UTCTime
currentTs)
    Connection -> IO UserId
insertedRowId Connection
db
  IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> (UserId, FileStatus, Maybe ConnReqInvitation,
    Maybe InlineFileMode, Maybe InlineFileMode, Maybe UserId, UTCTime,
    UTCTime)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
      Connection
db
      Query
"INSERT INTO rcv_files (file_id, file_status, file_queue_info, file_inline, rcv_file_inline, file_descr_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
      (UserId
fileId, FileStatus
FSNew, Maybe ConnReqInvitation
fileConnReq, Maybe InlineFileMode
fileInline, Maybe InlineFileMode
rcvFileInline, Maybe UserId
rfdId, UTCTime
currentTs, UTCTime
currentTs)
  RcvFileTransfer -> ExceptT StoreError IO RcvFileTransfer
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RcvFileTransfer {UserId
fileId :: UserId
fileId :: UserId
fileId, Maybe XFTPRcvFile
xftpRcvFile :: Maybe XFTPRcvFile
xftpRcvFile :: Maybe XFTPRcvFile
xftpRcvFile, fileInvitation :: FileInvitation
fileInvitation = FileInvitation
f, fileStatus :: RcvFileStatus
fileStatus = RcvFileStatus
RFSNew, Maybe InlineFileMode
rcvFileInline :: Maybe InlineFileMode
rcvFileInline :: Maybe InlineFileMode
rcvFileInline, senderDisplayName :: Text
senderDisplayName = Text
c, Integer
chunkSize :: Integer
chunkSize :: Integer
chunkSize, cancelled :: Bool
cancelled = Bool
False, grpMemberId :: Maybe UserId
grpMemberId = Maybe UserId
forall a. Maybe a
Nothing, cryptoArgs :: Maybe CryptoFileArgs
cryptoArgs = Maybe CryptoFileArgs
forall a. Maybe a
Nothing}

createRcvGroupFileTransfer :: DB.Connection -> UserId -> GroupMember -> FileInvitation -> Maybe InlineFileMode -> Integer -> ExceptT StoreError IO RcvFileTransfer
createRcvGroupFileTransfer :: Connection
-> UserId
-> GroupMember
-> FileInvitation
-> Maybe InlineFileMode
-> Integer
-> ExceptT StoreError IO RcvFileTransfer
createRcvGroupFileTransfer Connection
db UserId
userId GroupMember {UserId
groupId :: UserId
groupId :: GroupMember -> UserId
groupId, UserId
groupMemberId :: GroupMember -> UserId
groupMemberId :: UserId
groupMemberId, localDisplayName :: GroupMember -> Text
localDisplayName = Text
c} f :: FileInvitation
f@FileInvitation {FilePath
fileName :: FileInvitation -> FilePath
fileName :: FilePath
fileName, Integer
fileSize :: FileInvitation -> Integer
fileSize :: Integer
fileSize, Maybe ConnReqInvitation
fileConnReq :: FileInvitation -> Maybe ConnReqInvitation
fileConnReq :: Maybe ConnReqInvitation
fileConnReq, Maybe InlineFileMode
fileInline :: FileInvitation -> Maybe InlineFileMode
fileInline :: Maybe InlineFileMode
fileInline, Maybe FileDescr
fileDescr :: FileInvitation -> Maybe FileDescr
fileDescr :: Maybe FileDescr
fileDescr} Maybe InlineFileMode
rcvFileInline Integer
chunkSize = do
  UTCTime
currentTs <- IO UTCTime -> ExceptT StoreError IO UTCTime
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  Maybe RcvFileDescr
rfd_ <- (FileDescr -> ExceptT StoreError IO RcvFileDescr)
-> Maybe FileDescr -> ExceptT StoreError IO (Maybe RcvFileDescr)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (Connection
-> UserId
-> UTCTime
-> FileDescr
-> ExceptT StoreError IO RcvFileDescr
createRcvFD_ Connection
db UserId
userId UTCTime
currentTs) Maybe FileDescr
fileDescr
  let rfdId :: Maybe UserId
rfdId = (\RcvFileDescr {UserId
fileDescrId :: RcvFileDescr -> UserId
fileDescrId :: UserId
fileDescrId} -> UserId
fileDescrId) (RcvFileDescr -> UserId) -> Maybe RcvFileDescr -> Maybe UserId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RcvFileDescr
rfd_
      -- cryptoArgs = Nothing here, the decision to encrypt is made when receiving it
      xftpRcvFile :: Maybe XFTPRcvFile
xftpRcvFile = (\RcvFileDescr
rfd -> XFTPRcvFile {rcvFileDescription :: RcvFileDescr
rcvFileDescription = RcvFileDescr
rfd, agentRcvFileId :: Maybe AgentRcvFileId
agentRcvFileId = Maybe AgentRcvFileId
forall a. Maybe a
Nothing, agentRcvFileDeleted :: Bool
agentRcvFileDeleted = Bool
False, userApprovedRelays :: Bool
userApprovedRelays = Bool
False}) (RcvFileDescr -> XFTPRcvFile)
-> Maybe RcvFileDescr -> Maybe XFTPRcvFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RcvFileDescr
rfd_
      fileProtocol :: FileProtocol
fileProtocol = if Maybe RcvFileDescr -> Bool
forall a. Maybe a -> Bool
isJust Maybe RcvFileDescr
rfd_ then FileProtocol
FPXFTP else FileProtocol
FPSMP
  UserId
fileId <- IO UserId -> ExceptT StoreError IO UserId
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UserId -> ExceptT StoreError IO UserId)
-> IO UserId -> ExceptT StoreError IO UserId
forall a b. (a -> b) -> a -> b
$ do
    Connection
-> Query
-> (UserId, UserId, FilePath, Integer, Integer,
    Maybe InlineFileMode, CIFileStatus 'MDRcv, FileProtocol, UTCTime,
    UTCTime)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
      Connection
db
      Query
"INSERT INTO files (user_id, group_id, file_name, file_size, chunk_size, file_inline, ci_file_status, protocol, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?)"
      (UserId
userId, UserId
groupId, FilePath
fileName, Integer
fileSize, Integer
chunkSize, Maybe InlineFileMode
fileInline, CIFileStatus 'MDRcv
CIFSRcvInvitation, FileProtocol
fileProtocol, UTCTime
currentTs, UTCTime
currentTs)
    Connection -> IO UserId
insertedRowId Connection
db
  IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> (UserId, FileStatus, Maybe ConnReqInvitation,
    Maybe InlineFileMode, Maybe InlineFileMode, UserId, Maybe UserId,
    UTCTime, UTCTime)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
      Connection
db
      Query
"INSERT INTO rcv_files (file_id, file_status, file_queue_info, file_inline, rcv_file_inline, group_member_id, file_descr_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)"
      (UserId
fileId, FileStatus
FSNew, Maybe ConnReqInvitation
fileConnReq, Maybe InlineFileMode
fileInline, Maybe InlineFileMode
rcvFileInline, UserId
groupMemberId, Maybe UserId
rfdId, UTCTime
currentTs, UTCTime
currentTs)
  RcvFileTransfer -> ExceptT StoreError IO RcvFileTransfer
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RcvFileTransfer {UserId
fileId :: UserId
fileId :: UserId
fileId, Maybe XFTPRcvFile
xftpRcvFile :: Maybe XFTPRcvFile
xftpRcvFile :: Maybe XFTPRcvFile
xftpRcvFile, fileInvitation :: FileInvitation
fileInvitation = FileInvitation
f, fileStatus :: RcvFileStatus
fileStatus = RcvFileStatus
RFSNew, Maybe InlineFileMode
rcvFileInline :: Maybe InlineFileMode
rcvFileInline :: Maybe InlineFileMode
rcvFileInline, senderDisplayName :: Text
senderDisplayName = Text
c, Integer
chunkSize :: Integer
chunkSize :: Integer
chunkSize, cancelled :: Bool
cancelled = Bool
False, grpMemberId :: Maybe UserId
grpMemberId = UserId -> Maybe UserId
forall a. a -> Maybe a
Just UserId
groupMemberId, cryptoArgs :: Maybe CryptoFileArgs
cryptoArgs = Maybe CryptoFileArgs
forall a. Maybe a
Nothing}

createRcvStandaloneFileTransfer :: DB.Connection -> UserId -> CryptoFile -> Int64 -> Word32 -> ExceptT StoreError IO Int64
createRcvStandaloneFileTransfer :: Connection
-> UserId
-> CryptoFile
-> UserId
-> Word32
-> ExceptT StoreError IO UserId
createRcvStandaloneFileTransfer Connection
db UserId
userId (CryptoFile FilePath
filePath Maybe CryptoFileArgs
cfArgs_) UserId
fileSize Word32
chunkSize = do
  UTCTime
currentTs <- IO UTCTime -> ExceptT StoreError IO UTCTime
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  UserId
fileId <- IO UserId -> ExceptT StoreError IO UserId
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UserId -> ExceptT StoreError IO UserId)
-> IO UserId -> ExceptT StoreError IO UserId
forall a b. (a -> b) -> a -> b
$ do
    Connection
-> Query
-> (UserId, FilePath, FilePath, UserId, Word32,
    CIFileStatus 'MDRcv, FileProtocol, UTCTime, UTCTime)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
      Connection
db
      Query
"INSERT INTO files (user_id, file_name, file_path, file_size, chunk_size, ci_file_status, protocol, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)"
      (UserId
userId, FilePath -> FilePath
takeFileName FilePath
filePath, FilePath
filePath, UserId
fileSize, Word32
chunkSize, CIFileStatus 'MDRcv
CIFSRcvInvitation, FileProtocol
FPXFTP, UTCTime
currentTs, UTCTime
currentTs)
    Connection -> IO UserId
insertedRowId Connection
db
  IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> ((CryptoFileArgs -> IO ()) -> IO ())
-> (CryptoFileArgs -> IO ())
-> ExceptT StoreError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe CryptoFileArgs -> (CryptoFileArgs -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe CryptoFileArgs
cfArgs_ ((CryptoFileArgs -> IO ()) -> ExceptT StoreError IO ())
-> (CryptoFileArgs -> IO ()) -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ \CryptoFileArgs
cfArgs -> Connection -> UserId -> CryptoFileArgs -> UTCTime -> IO ()
setFileCryptoArgs_ Connection
db UserId
fileId CryptoFileArgs
cfArgs UTCTime
currentTs
  IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query -> (UserId, FileStatus, UTCTime, UTCTime) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
      Connection
db
      Query
"INSERT INTO rcv_files (file_id, file_status, created_at, updated_at) VALUES (?,?,?,?)"
      (UserId
fileId, FileStatus
FSNew, UTCTime
currentTs, UTCTime
currentTs)
  UserId -> ExceptT StoreError IO UserId
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UserId
fileId

createRcvFD_ :: DB.Connection -> UserId -> UTCTime -> FileDescr -> ExceptT StoreError IO RcvFileDescr
createRcvFD_ :: Connection
-> UserId
-> UTCTime
-> FileDescr
-> ExceptT StoreError IO RcvFileDescr
createRcvFD_ Connection
db UserId
userId UTCTime
currentTs FileDescr {Text
fileDescrText :: FileDescr -> Text
fileDescrText :: Text
fileDescrText, Int
fileDescrPartNo :: FileDescr -> Int
fileDescrPartNo :: Int
fileDescrPartNo, Bool
fileDescrComplete :: FileDescr -> Bool
fileDescrComplete :: Bool
fileDescrComplete} = do
  Bool -> ExceptT StoreError IO () -> ExceptT StoreError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
fileDescrPartNo Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (ExceptT StoreError IO () -> ExceptT StoreError IO ())
-> ExceptT StoreError IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ StoreError -> ExceptT StoreError IO ()
forall a. StoreError -> ExceptT StoreError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError StoreError
SERcvFileInvalidDescrPart
  UserId
fileDescrId <- IO UserId -> ExceptT StoreError IO UserId
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UserId -> ExceptT StoreError IO UserId)
-> IO UserId -> ExceptT StoreError IO UserId
forall a b. (a -> b) -> a -> b
$ do
    Connection
-> Query -> (UserId, Text, Int, BoolInt, UTCTime, UTCTime) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
      Connection
db
      Query
"INSERT INTO xftp_file_descriptions (user_id, file_descr_text, file_descr_part_no, file_descr_complete, created_at, updated_at) VALUES (?,?,?,?,?,?)"
      (UserId
userId, Text
fileDescrText, Int
fileDescrPartNo, Bool -> BoolInt
BI Bool
fileDescrComplete, UTCTime
currentTs, UTCTime
currentTs)
    Connection -> IO UserId
insertedRowId Connection
db
  RcvFileDescr -> ExceptT StoreError IO RcvFileDescr
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RcvFileDescr {UserId
fileDescrId :: UserId
fileDescrId :: UserId
fileDescrId, Int
fileDescrPartNo :: Int
fileDescrPartNo :: Int
fileDescrPartNo, Text
fileDescrText :: Text
fileDescrText :: Text
fileDescrText, Bool
fileDescrComplete :: Bool
fileDescrComplete :: Bool
fileDescrComplete}

appendRcvFD :: DB.Connection -> UserId -> FileTransferId -> FileDescr -> ExceptT StoreError IO RcvFileDescr
appendRcvFD :: Connection
-> UserId
-> UserId
-> FileDescr
-> ExceptT StoreError IO RcvFileDescr
appendRcvFD Connection
db UserId
userId UserId
fileId fd :: FileDescr
fd@FileDescr {Text
fileDescrText :: FileDescr -> Text
fileDescrText :: Text
fileDescrText, Int
fileDescrPartNo :: FileDescr -> Int
fileDescrPartNo :: Int
fileDescrPartNo, Bool
fileDescrComplete :: FileDescr -> Bool
fileDescrComplete :: Bool
fileDescrComplete} = do
  UTCTime
currentTs <- IO UTCTime -> ExceptT StoreError IO UTCTime
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  IO (Maybe RcvFileDescr)
-> ExceptT StoreError IO (Maybe RcvFileDescr)
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Connection -> UserId -> IO (Maybe RcvFileDescr)
getRcvFileDescrByRcvFileId_ Connection
db UserId
fileId) ExceptT StoreError IO (Maybe RcvFileDescr)
-> (Maybe RcvFileDescr -> ExceptT StoreError IO RcvFileDescr)
-> ExceptT StoreError IO RcvFileDescr
forall a b.
ExceptT StoreError IO a
-> (a -> ExceptT StoreError IO b) -> ExceptT StoreError IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe RcvFileDescr
Nothing -> do
      rfd :: RcvFileDescr
rfd@RcvFileDescr {UserId
fileDescrId :: RcvFileDescr -> UserId
fileDescrId :: UserId
fileDescrId} <- Connection
-> UserId
-> UTCTime
-> FileDescr
-> ExceptT StoreError IO RcvFileDescr
createRcvFD_ Connection
db UserId
userId UTCTime
currentTs FileDescr
fd
      IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$
        Connection -> Query -> (UserId, UTCTime, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
          Connection
db
          Query
"UPDATE rcv_files SET file_descr_id = ?, updated_at = ? WHERE file_id = ?"
          (UserId
fileDescrId, UTCTime
currentTs, UserId
fileId)
      RcvFileDescr -> ExceptT StoreError IO RcvFileDescr
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RcvFileDescr
rfd
    Just
      RcvFileDescr
        { UserId
fileDescrId :: RcvFileDescr -> UserId
fileDescrId :: UserId
fileDescrId,
          fileDescrText :: RcvFileDescr -> Text
fileDescrText = Text
rfdText,
          fileDescrPartNo :: RcvFileDescr -> Int
fileDescrPartNo = Int
rfdPNo,
          fileDescrComplete :: RcvFileDescr -> Bool
fileDescrComplete = Bool
rfdComplete
        } -> do
        Bool -> ExceptT StoreError IO () -> ExceptT StoreError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
fileDescrPartNo Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
rfdPNo Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Bool -> Bool -> Bool
|| Bool
rfdComplete) (ExceptT StoreError IO () -> ExceptT StoreError IO ())
-> ExceptT StoreError IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ StoreError -> ExceptT StoreError IO ()
forall a. StoreError -> ExceptT StoreError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError StoreError
SERcvFileInvalidDescrPart
        let fileDescrText' :: Text
fileDescrText' = Text
rfdText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fileDescrText
        IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$
          Connection -> Query -> (Text, Int, BoolInt, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
            Connection
db
            [sql|
              UPDATE xftp_file_descriptions
              SET file_descr_text = ?, file_descr_part_no = ?, file_descr_complete = ?
              WHERE file_descr_id = ?
            |]
            (Text
fileDescrText', Int
fileDescrPartNo, Bool -> BoolInt
BI Bool
fileDescrComplete, UserId
fileDescrId)
        RcvFileDescr -> ExceptT StoreError IO RcvFileDescr
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RcvFileDescr {UserId
fileDescrId :: UserId
fileDescrId :: UserId
fileDescrId, fileDescrText :: Text
fileDescrText = Text
fileDescrText', Int
fileDescrPartNo :: Int
fileDescrPartNo :: Int
fileDescrPartNo, Bool
fileDescrComplete :: Bool
fileDescrComplete :: Bool
fileDescrComplete}

getRcvFileDescrByRcvFileId :: DB.Connection -> FileTransferId -> ExceptT StoreError IO RcvFileDescr
getRcvFileDescrByRcvFileId :: Connection -> UserId -> ExceptT StoreError IO RcvFileDescr
getRcvFileDescrByRcvFileId Connection
db UserId
fileId = do
  IO (Maybe RcvFileDescr)
-> ExceptT StoreError IO (Maybe RcvFileDescr)
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Connection -> UserId -> IO (Maybe RcvFileDescr)
getRcvFileDescrByRcvFileId_ Connection
db UserId
fileId) ExceptT StoreError IO (Maybe RcvFileDescr)
-> (Maybe RcvFileDescr -> ExceptT StoreError IO RcvFileDescr)
-> ExceptT StoreError IO RcvFileDescr
forall a b.
ExceptT StoreError IO a
-> (a -> ExceptT StoreError IO b) -> ExceptT StoreError IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe RcvFileDescr
Nothing -> StoreError -> ExceptT StoreError IO RcvFileDescr
forall a. StoreError -> ExceptT StoreError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (StoreError -> ExceptT StoreError IO RcvFileDescr)
-> StoreError -> ExceptT StoreError IO RcvFileDescr
forall a b. (a -> b) -> a -> b
$ UserId -> StoreError
SERcvFileDescrNotFound UserId
fileId
    Just RcvFileDescr
rfd -> RcvFileDescr -> ExceptT StoreError IO RcvFileDescr
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RcvFileDescr
rfd

getRcvFileDescrByRcvFileId_ :: DB.Connection -> FileTransferId -> IO (Maybe RcvFileDescr)
getRcvFileDescrByRcvFileId_ :: Connection -> UserId -> IO (Maybe RcvFileDescr)
getRcvFileDescrByRcvFileId_ Connection
db UserId
fileId =
  ((UserId, Text, Int, BoolInt) -> RcvFileDescr)
-> IO [(UserId, Text, Int, BoolInt)] -> IO (Maybe RcvFileDescr)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow (UserId, Text, Int, BoolInt) -> RcvFileDescr
toRcvFileDescr (IO [(UserId, Text, Int, BoolInt)] -> IO (Maybe RcvFileDescr))
-> IO [(UserId, Text, Int, BoolInt)] -> IO (Maybe RcvFileDescr)
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query -> Only UserId -> IO [(UserId, Text, Int, BoolInt)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT d.file_descr_id, d.file_descr_text, d.file_descr_part_no, d.file_descr_complete
        FROM xftp_file_descriptions d
        JOIN rcv_files f ON f.file_descr_id = d.file_descr_id
        WHERE f.file_id = ?
        LIMIT 1
      |]
      (UserId -> Only UserId
forall a. a -> Only a
Only UserId
fileId)

getRcvFileDescrBySndFileId :: DB.Connection -> FileTransferId -> ExceptT StoreError IO RcvFileDescr
getRcvFileDescrBySndFileId :: Connection -> UserId -> ExceptT StoreError IO RcvFileDescr
getRcvFileDescrBySndFileId Connection
db UserId
fileId = do
  IO (Maybe RcvFileDescr)
-> ExceptT StoreError IO (Maybe RcvFileDescr)
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Connection -> UserId -> IO (Maybe RcvFileDescr)
getRcvFileDescrBySndFileId_ Connection
db UserId
fileId) ExceptT StoreError IO (Maybe RcvFileDescr)
-> (Maybe RcvFileDescr -> ExceptT StoreError IO RcvFileDescr)
-> ExceptT StoreError IO RcvFileDescr
forall a b.
ExceptT StoreError IO a
-> (a -> ExceptT StoreError IO b) -> ExceptT StoreError IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe RcvFileDescr
Nothing -> StoreError -> ExceptT StoreError IO RcvFileDescr
forall a. StoreError -> ExceptT StoreError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (StoreError -> ExceptT StoreError IO RcvFileDescr)
-> StoreError -> ExceptT StoreError IO RcvFileDescr
forall a b. (a -> b) -> a -> b
$ UserId -> StoreError
SERcvFileDescrNotFound UserId
fileId
    Just RcvFileDescr
rfd -> RcvFileDescr -> ExceptT StoreError IO RcvFileDescr
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RcvFileDescr
rfd

getRcvFileDescrBySndFileId_ :: DB.Connection -> FileTransferId -> IO (Maybe RcvFileDescr)
getRcvFileDescrBySndFileId_ :: Connection -> UserId -> IO (Maybe RcvFileDescr)
getRcvFileDescrBySndFileId_ Connection
db UserId
fileId =
  ((UserId, Text, Int, BoolInt) -> RcvFileDescr)
-> IO [(UserId, Text, Int, BoolInt)] -> IO (Maybe RcvFileDescr)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f [a] -> f (Maybe b)
maybeFirstRow (UserId, Text, Int, BoolInt) -> RcvFileDescr
toRcvFileDescr (IO [(UserId, Text, Int, BoolInt)] -> IO (Maybe RcvFileDescr))
-> IO [(UserId, Text, Int, BoolInt)] -> IO (Maybe RcvFileDescr)
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query -> Only UserId -> IO [(UserId, Text, Int, BoolInt)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT d.file_descr_id, d.file_descr_text, d.file_descr_part_no, d.file_descr_complete
        FROM xftp_file_descriptions d
        JOIN snd_files f ON f.file_descr_id = d.file_descr_id
        WHERE f.file_id = ?
        LIMIT 1
      |]
      (UserId -> Only UserId
forall a. a -> Only a
Only UserId
fileId)

toRcvFileDescr :: (Int64, Text, Int, BoolInt) -> RcvFileDescr
toRcvFileDescr :: (UserId, Text, Int, BoolInt) -> RcvFileDescr
toRcvFileDescr (UserId
fileDescrId, Text
fileDescrText, Int
fileDescrPartNo, BI Bool
fileDescrComplete) =
  RcvFileDescr {UserId
fileDescrId :: UserId
fileDescrId :: UserId
fileDescrId, Text
fileDescrText :: Text
fileDescrText :: Text
fileDescrText, Int
fileDescrPartNo :: Int
fileDescrPartNo :: Int
fileDescrPartNo, Bool
fileDescrComplete :: Bool
fileDescrComplete :: Bool
fileDescrComplete}

updateRcvFileAgentId :: DB.Connection -> FileTransferId -> Maybe AgentRcvFileId -> IO ()
updateRcvFileAgentId :: Connection -> UserId -> Maybe AgentRcvFileId -> IO ()
updateRcvFileAgentId Connection
db UserId
fileId Maybe AgentRcvFileId
aFileId = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  Connection
-> Query -> (Maybe AgentRcvFileId, UTCTime, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE rcv_files SET agent_rcv_file_id = ?, updated_at = ? WHERE file_id = ?" (Maybe AgentRcvFileId
aFileId, UTCTime
currentTs, UserId
fileId)

getRcvFileTransferById :: DB.Connection -> FileTransferId -> ExceptT StoreError IO (User, RcvFileTransfer)
getRcvFileTransferById :: Connection
-> UserId -> ExceptT StoreError IO (User, RcvFileTransfer)
getRcvFileTransferById Connection
db UserId
fileId = do
  User
user <- Connection -> UserId -> ExceptT StoreError IO User
getUserByFileId Connection
db UserId
fileId
  (User
user,) (RcvFileTransfer -> (User, RcvFileTransfer))
-> ExceptT StoreError IO RcvFileTransfer
-> ExceptT StoreError IO (User, RcvFileTransfer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> User -> UserId -> ExceptT StoreError IO RcvFileTransfer
getRcvFileTransfer Connection
db User
user UserId
fileId

getRcvFileTransfer :: DB.Connection -> User -> FileTransferId -> ExceptT StoreError IO RcvFileTransfer
getRcvFileTransfer :: Connection
-> User -> UserId -> ExceptT StoreError IO RcvFileTransfer
getRcvFileTransfer Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} = Connection
-> UserId -> UserId -> ExceptT StoreError IO RcvFileTransfer
getRcvFileTransfer_ Connection
db UserId
userId

getRcvFileTransfer_ :: DB.Connection -> UserId -> FileTransferId -> ExceptT StoreError IO RcvFileTransfer
getRcvFileTransfer_ :: Connection
-> UserId -> UserId -> ExceptT StoreError IO RcvFileTransfer
getRcvFileTransfer_ Connection
db UserId
userId UserId
fileId = do
  (FileStatus, Maybe ConnReqInvitation, Maybe UserId, FilePath,
 Integer, Integer, Maybe BoolInt)
:. (Maybe Text, Maybe Text, Maybe FilePath, Maybe SbKey,
    Maybe CbNonce, Maybe InlineFileMode, Maybe InlineFileMode,
    Maybe AgentRcvFileId, BoolInt, BoolInt)
rftRow <-
    IO
  (Either
     StoreError
     ((FileStatus, Maybe ConnReqInvitation, Maybe UserId, FilePath,
       Integer, Integer, Maybe BoolInt)
      :. (Maybe Text, Maybe Text, Maybe FilePath, Maybe SbKey,
          Maybe CbNonce, Maybe InlineFileMode, Maybe InlineFileMode,
          Maybe AgentRcvFileId, BoolInt, BoolInt)))
-> ExceptT
     StoreError
     IO
     ((FileStatus, Maybe ConnReqInvitation, Maybe UserId, FilePath,
       Integer, Integer, Maybe BoolInt)
      :. (Maybe Text, Maybe Text, Maybe FilePath, Maybe SbKey,
          Maybe CbNonce, Maybe InlineFileMode, Maybe InlineFileMode,
          Maybe AgentRcvFileId, BoolInt, BoolInt))
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO
   (Either
      StoreError
      ((FileStatus, Maybe ConnReqInvitation, Maybe UserId, FilePath,
        Integer, Integer, Maybe BoolInt)
       :. (Maybe Text, Maybe Text, Maybe FilePath, Maybe SbKey,
           Maybe CbNonce, Maybe InlineFileMode, Maybe InlineFileMode,
           Maybe AgentRcvFileId, BoolInt, BoolInt)))
 -> ExceptT
      StoreError
      IO
      ((FileStatus, Maybe ConnReqInvitation, Maybe UserId, FilePath,
        Integer, Integer, Maybe BoolInt)
       :. (Maybe Text, Maybe Text, Maybe FilePath, Maybe SbKey,
           Maybe CbNonce, Maybe InlineFileMode, Maybe InlineFileMode,
           Maybe AgentRcvFileId, BoolInt, BoolInt)))
-> (IO
      [(FileStatus, Maybe ConnReqInvitation, Maybe UserId, FilePath,
        Integer, Integer, Maybe BoolInt)
       :. (Maybe Text, Maybe Text, Maybe FilePath, Maybe SbKey,
           Maybe CbNonce, Maybe InlineFileMode, Maybe InlineFileMode,
           Maybe AgentRcvFileId, BoolInt, BoolInt)]
    -> IO
         (Either
            StoreError
            ((FileStatus, Maybe ConnReqInvitation, Maybe UserId, FilePath,
              Integer, Integer, Maybe BoolInt)
             :. (Maybe Text, Maybe Text, Maybe FilePath, Maybe SbKey,
                 Maybe CbNonce, Maybe InlineFileMode, Maybe InlineFileMode,
                 Maybe AgentRcvFileId, BoolInt, BoolInt))))
-> IO
     [(FileStatus, Maybe ConnReqInvitation, Maybe UserId, FilePath,
       Integer, Integer, Maybe BoolInt)
      :. (Maybe Text, Maybe Text, Maybe FilePath, Maybe SbKey,
          Maybe CbNonce, Maybe InlineFileMode, Maybe InlineFileMode,
          Maybe AgentRcvFileId, BoolInt, BoolInt)]
-> ExceptT
     StoreError
     IO
     ((FileStatus, Maybe ConnReqInvitation, Maybe UserId, FilePath,
       Integer, Integer, Maybe BoolInt)
      :. (Maybe Text, Maybe Text, Maybe FilePath, Maybe SbKey,
          Maybe CbNonce, Maybe InlineFileMode, Maybe InlineFileMode,
          Maybe AgentRcvFileId, BoolInt, BoolInt))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((FileStatus, Maybe ConnReqInvitation, Maybe UserId, FilePath,
   Integer, Integer, Maybe BoolInt)
  :. (Maybe Text, Maybe Text, Maybe FilePath, Maybe SbKey,
      Maybe CbNonce, Maybe InlineFileMode, Maybe InlineFileMode,
      Maybe AgentRcvFileId, BoolInt, BoolInt))
 -> (FileStatus, Maybe ConnReqInvitation, Maybe UserId, FilePath,
     Integer, Integer, Maybe BoolInt)
    :. (Maybe Text, Maybe Text, Maybe FilePath, Maybe SbKey,
        Maybe CbNonce, Maybe InlineFileMode, Maybe InlineFileMode,
        Maybe AgentRcvFileId, BoolInt, BoolInt))
-> StoreError
-> IO
     [(FileStatus, Maybe ConnReqInvitation, Maybe UserId, FilePath,
       Integer, Integer, Maybe BoolInt)
      :. (Maybe Text, Maybe Text, Maybe FilePath, Maybe SbKey,
          Maybe CbNonce, Maybe InlineFileMode, Maybe InlineFileMode,
          Maybe AgentRcvFileId, BoolInt, BoolInt)]
-> IO
     (Either
        StoreError
        ((FileStatus, Maybe ConnReqInvitation, Maybe UserId, FilePath,
          Integer, Integer, Maybe BoolInt)
         :. (Maybe Text, Maybe Text, Maybe FilePath, Maybe SbKey,
             Maybe CbNonce, Maybe InlineFileMode, Maybe InlineFileMode,
             Maybe AgentRcvFileId, BoolInt, BoolInt)))
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow ((FileStatus, Maybe ConnReqInvitation, Maybe UserId, FilePath,
  Integer, Integer, Maybe BoolInt)
 :. (Maybe Text, Maybe Text, Maybe FilePath, Maybe SbKey,
     Maybe CbNonce, Maybe InlineFileMode, Maybe InlineFileMode,
     Maybe AgentRcvFileId, BoolInt, BoolInt))
-> (FileStatus, Maybe ConnReqInvitation, Maybe UserId, FilePath,
    Integer, Integer, Maybe BoolInt)
   :. (Maybe Text, Maybe Text, Maybe FilePath, Maybe SbKey,
       Maybe CbNonce, Maybe InlineFileMode, Maybe InlineFileMode,
       Maybe AgentRcvFileId, BoolInt, BoolInt)
forall a. a -> a
id (UserId -> StoreError
SERcvFileNotFound UserId
fileId) (IO
   [(FileStatus, Maybe ConnReqInvitation, Maybe UserId, FilePath,
     Integer, Integer, Maybe BoolInt)
    :. (Maybe Text, Maybe Text, Maybe FilePath, Maybe SbKey,
        Maybe CbNonce, Maybe InlineFileMode, Maybe InlineFileMode,
        Maybe AgentRcvFileId, BoolInt, BoolInt)]
 -> ExceptT
      StoreError
      IO
      ((FileStatus, Maybe ConnReqInvitation, Maybe UserId, FilePath,
        Integer, Integer, Maybe BoolInt)
       :. (Maybe Text, Maybe Text, Maybe FilePath, Maybe SbKey,
           Maybe CbNonce, Maybe InlineFileMode, Maybe InlineFileMode,
           Maybe AgentRcvFileId, BoolInt, BoolInt)))
-> IO
     [(FileStatus, Maybe ConnReqInvitation, Maybe UserId, FilePath,
       Integer, Integer, Maybe BoolInt)
      :. (Maybe Text, Maybe Text, Maybe FilePath, Maybe SbKey,
          Maybe CbNonce, Maybe InlineFileMode, Maybe InlineFileMode,
          Maybe AgentRcvFileId, BoolInt, BoolInt)]
-> ExceptT
     StoreError
     IO
     ((FileStatus, Maybe ConnReqInvitation, Maybe UserId, FilePath,
       Integer, Integer, Maybe BoolInt)
      :. (Maybe Text, Maybe Text, Maybe FilePath, Maybe SbKey,
          Maybe CbNonce, Maybe InlineFileMode, Maybe InlineFileMode,
          Maybe AgentRcvFileId, BoolInt, BoolInt))
forall a b. (a -> b) -> a -> b
$
      Connection
-> Query
-> (UserId, UserId)
-> IO
     [(FileStatus, Maybe ConnReqInvitation, Maybe UserId, FilePath,
       Integer, Integer, Maybe BoolInt)
      :. (Maybe Text, Maybe Text, Maybe FilePath, Maybe SbKey,
          Maybe CbNonce, Maybe InlineFileMode, Maybe InlineFileMode,
          Maybe AgentRcvFileId, BoolInt, BoolInt)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
        Connection
db
        [sql|
          SELECT r.file_status, r.file_queue_info, r.group_member_id, f.file_name,
            f.file_size, f.chunk_size, f.cancelled, cs.local_display_name, m.local_display_name,
            f.file_path, f.file_crypto_key, f.file_crypto_nonce, r.file_inline, r.rcv_file_inline,
            r.agent_rcv_file_id, r.agent_rcv_file_deleted, r.user_approved_relays
          FROM rcv_files r
          JOIN files f USING (file_id)
          LEFT JOIN contacts cs ON cs.contact_id = f.contact_id
          LEFT JOIN group_members m ON m.group_member_id = r.group_member_id
          WHERE f.user_id = ? AND f.file_id = ?
        |]
        (UserId
userId, UserId
fileId)
  Maybe RcvFileDescr
rfd_ <- IO (Maybe RcvFileDescr)
-> ExceptT StoreError IO (Maybe RcvFileDescr)
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe RcvFileDescr)
 -> ExceptT StoreError IO (Maybe RcvFileDescr))
-> IO (Maybe RcvFileDescr)
-> ExceptT StoreError IO (Maybe RcvFileDescr)
forall a b. (a -> b) -> a -> b
$ Connection -> UserId -> IO (Maybe RcvFileDescr)
getRcvFileDescrByRcvFileId_ Connection
db UserId
fileId
  Maybe RcvFileDescr
-> ((FileStatus, Maybe ConnReqInvitation, Maybe UserId, FilePath,
     Integer, Integer, Maybe BoolInt)
    :. (Maybe Text, Maybe Text, Maybe FilePath, Maybe SbKey,
        Maybe CbNonce, Maybe InlineFileMode, Maybe InlineFileMode,
        Maybe AgentRcvFileId, BoolInt, BoolInt))
-> ExceptT StoreError IO RcvFileTransfer
rcvFileTransfer Maybe RcvFileDescr
rfd_ (FileStatus, Maybe ConnReqInvitation, Maybe UserId, FilePath,
 Integer, Integer, Maybe BoolInt)
:. (Maybe Text, Maybe Text, Maybe FilePath, Maybe SbKey,
    Maybe CbNonce, Maybe InlineFileMode, Maybe InlineFileMode,
    Maybe AgentRcvFileId, BoolInt, BoolInt)
rftRow
  where
    rcvFileTransfer ::
      Maybe RcvFileDescr ->
      (FileStatus, Maybe ConnReqInvitation, Maybe Int64, String, Integer, Integer, Maybe BoolInt) :. (Maybe ContactName, Maybe ContactName, Maybe FilePath, Maybe C.SbKey, Maybe C.CbNonce, Maybe InlineFileMode, Maybe InlineFileMode, Maybe AgentRcvFileId, BoolInt, BoolInt) ->
      ExceptT StoreError IO RcvFileTransfer
    rcvFileTransfer :: Maybe RcvFileDescr
-> ((FileStatus, Maybe ConnReqInvitation, Maybe UserId, FilePath,
     Integer, Integer, Maybe BoolInt)
    :. (Maybe Text, Maybe Text, Maybe FilePath, Maybe SbKey,
        Maybe CbNonce, Maybe InlineFileMode, Maybe InlineFileMode,
        Maybe AgentRcvFileId, BoolInt, BoolInt))
-> ExceptT StoreError IO RcvFileTransfer
rcvFileTransfer Maybe RcvFileDescr
rfd_ ((FileStatus
fileStatus', Maybe ConnReqInvitation
fileConnReq, Maybe UserId
grpMemberId, FilePath
fileName, Integer
fileSize, Integer
chunkSize, Maybe BoolInt
cancelled_) :. (Maybe Text
contactName_, Maybe Text
memberName_, Maybe FilePath
filePath_, Maybe SbKey
fileKey, Maybe CbNonce
fileNonce, Maybe InlineFileMode
fileInline, Maybe InlineFileMode
rcvFileInline, Maybe AgentRcvFileId
agentRcvFileId, BI Bool
agentRcvFileDeleted, BI Bool
userApprovedRelays)) =
      case Maybe Text
contactName_ Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
memberName_ Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
standaloneName_ of
        Maybe Text
Nothing -> StoreError -> ExceptT StoreError IO RcvFileTransfer
forall a. StoreError -> ExceptT StoreError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (StoreError -> ExceptT StoreError IO RcvFileTransfer)
-> StoreError -> ExceptT StoreError IO RcvFileTransfer
forall a b. (a -> b) -> a -> b
$ UserId -> StoreError
SERcvFileInvalid UserId
fileId
        Just Text
name ->
          case FileStatus
fileStatus' of
            FileStatus
FSNew -> RcvFileTransfer -> ExceptT StoreError IO RcvFileTransfer
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RcvFileTransfer -> ExceptT StoreError IO RcvFileTransfer)
-> RcvFileTransfer -> ExceptT StoreError IO RcvFileTransfer
forall a b. (a -> b) -> a -> b
$ Text -> RcvFileStatus -> RcvFileTransfer
ft Text
name RcvFileStatus
RFSNew
            FileStatus
FSAccepted -> Text -> RcvFileStatus -> RcvFileTransfer
ft Text
name (RcvFileStatus -> RcvFileTransfer)
-> (FilePath -> RcvFileStatus) -> FilePath -> RcvFileTransfer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> RcvFileStatus
RFSAccepted (FilePath -> RcvFileTransfer)
-> ExceptT StoreError IO FilePath
-> ExceptT StoreError IO RcvFileTransfer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT StoreError IO FilePath
filePath
            FileStatus
FSConnected -> Text -> RcvFileStatus -> RcvFileTransfer
ft Text
name (RcvFileStatus -> RcvFileTransfer)
-> (FilePath -> RcvFileStatus) -> FilePath -> RcvFileTransfer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> RcvFileStatus
RFSConnected (FilePath -> RcvFileTransfer)
-> ExceptT StoreError IO FilePath
-> ExceptT StoreError IO RcvFileTransfer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT StoreError IO FilePath
filePath
            FileStatus
FSComplete -> Text -> RcvFileStatus -> RcvFileTransfer
ft Text
name (RcvFileStatus -> RcvFileTransfer)
-> (FilePath -> RcvFileStatus) -> FilePath -> RcvFileTransfer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> RcvFileStatus
RFSComplete (FilePath -> RcvFileTransfer)
-> ExceptT StoreError IO FilePath
-> ExceptT StoreError IO RcvFileTransfer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT StoreError IO FilePath
filePath
            FileStatus
FSCancelled -> RcvFileTransfer -> ExceptT StoreError IO RcvFileTransfer
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RcvFileTransfer -> ExceptT StoreError IO RcvFileTransfer)
-> RcvFileTransfer -> ExceptT StoreError IO RcvFileTransfer
forall a b. (a -> b) -> a -> b
$ Text -> RcvFileStatus -> RcvFileTransfer
ft Text
name (Maybe FilePath -> RcvFileStatus
RFSCancelled Maybe FilePath
filePath_)
      where
        standaloneName_ :: Maybe Text
standaloneName_ = case (Maybe AgentRcvFileId
agentRcvFileId, Maybe FilePath
filePath_) of
          (Just AgentRcvFileId
_, Just FilePath
_) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"" -- filePath marks files that are accepted from contact or, in this case, set by createRcvDirectFileTransfer
          (Maybe AgentRcvFileId, Maybe FilePath)
_ -> Maybe Text
forall a. Maybe a
Nothing
        ft :: Text -> RcvFileStatus -> RcvFileTransfer
ft Text
senderDisplayName RcvFileStatus
fileStatus =
          let fileInvitation :: FileInvitation
fileInvitation = FileInvitation {FilePath
fileName :: FilePath
fileName :: FilePath
fileName, Integer
fileSize :: Integer
fileSize :: Integer
fileSize, fileDigest :: Maybe FileDigest
fileDigest = Maybe FileDigest
forall a. Maybe a
Nothing, Maybe ConnReqInvitation
fileConnReq :: Maybe ConnReqInvitation
fileConnReq :: Maybe ConnReqInvitation
fileConnReq, Maybe InlineFileMode
fileInline :: Maybe InlineFileMode
fileInline :: Maybe InlineFileMode
fileInline, fileDescr :: Maybe FileDescr
fileDescr = Maybe FileDescr
forall a. Maybe a
Nothing}
              cryptoArgs :: Maybe CryptoFileArgs
cryptoArgs = SbKey -> CbNonce -> CryptoFileArgs
CFArgs (SbKey -> CbNonce -> CryptoFileArgs)
-> Maybe SbKey -> Maybe (CbNonce -> CryptoFileArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SbKey
fileKey Maybe (CbNonce -> CryptoFileArgs)
-> Maybe CbNonce -> Maybe CryptoFileArgs
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe CbNonce
fileNonce
              xftpRcvFile :: Maybe XFTPRcvFile
xftpRcvFile = (\RcvFileDescr
rfd -> XFTPRcvFile {rcvFileDescription :: RcvFileDescr
rcvFileDescription = RcvFileDescr
rfd, Maybe AgentRcvFileId
agentRcvFileId :: Maybe AgentRcvFileId
agentRcvFileId :: Maybe AgentRcvFileId
agentRcvFileId, Bool
agentRcvFileDeleted :: Bool
agentRcvFileDeleted :: Bool
agentRcvFileDeleted, Bool
userApprovedRelays :: Bool
userApprovedRelays :: Bool
userApprovedRelays}) (RcvFileDescr -> XFTPRcvFile)
-> Maybe RcvFileDescr -> Maybe XFTPRcvFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RcvFileDescr
rfd_
           in RcvFileTransfer {UserId
fileId :: UserId
fileId :: UserId
fileId, Maybe XFTPRcvFile
xftpRcvFile :: Maybe XFTPRcvFile
xftpRcvFile :: Maybe XFTPRcvFile
xftpRcvFile, FileInvitation
fileInvitation :: FileInvitation
fileInvitation :: FileInvitation
fileInvitation, RcvFileStatus
fileStatus :: RcvFileStatus
fileStatus :: RcvFileStatus
fileStatus, Maybe InlineFileMode
rcvFileInline :: Maybe InlineFileMode
rcvFileInline :: Maybe InlineFileMode
rcvFileInline, Text
senderDisplayName :: Text
senderDisplayName :: Text
senderDisplayName, Integer
chunkSize :: Integer
chunkSize :: Integer
chunkSize, Bool
cancelled :: Bool
cancelled :: Bool
cancelled, Maybe UserId
grpMemberId :: Maybe UserId
grpMemberId :: Maybe UserId
grpMemberId, Maybe CryptoFileArgs
cryptoArgs :: Maybe CryptoFileArgs
cryptoArgs :: Maybe CryptoFileArgs
cryptoArgs}
        filePath :: ExceptT StoreError IO FilePath
filePath = case Maybe FilePath
filePath_ of
          Maybe FilePath
Nothing -> StoreError -> ExceptT StoreError IO FilePath
forall a. StoreError -> ExceptT StoreError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (StoreError -> ExceptT StoreError IO FilePath)
-> StoreError -> ExceptT StoreError IO FilePath
forall a b. (a -> b) -> a -> b
$ UserId -> StoreError
SERcvFileInvalid UserId
fileId
          Just FilePath
fp -> FilePath -> ExceptT StoreError IO FilePath
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
fp
        cancelled :: Bool
cancelled = Bool -> (BoolInt -> Bool) -> Maybe BoolInt -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False BoolInt -> Bool
unBI Maybe BoolInt
cancelled_

acceptRcvInlineFT :: DB.Connection -> VersionRangeChat -> User -> FileTransferId -> FilePath -> ExceptT StoreError IO AChatItem
acceptRcvInlineFT :: Connection
-> VersionRangeChat
-> User
-> UserId
-> FilePath
-> ExceptT StoreError IO AChatItem
acceptRcvInlineFT Connection
db VersionRangeChat
vr User
user UserId
fileId FilePath
filePath = do
  IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ Connection
-> User
-> UserId
-> FilePath
-> Bool
-> Maybe InlineFileMode
-> UTCTime
-> IO ()
acceptRcvFT_ Connection
db User
user UserId
fileId FilePath
filePath Bool
False (InlineFileMode -> Maybe InlineFileMode
forall a. a -> Maybe a
Just InlineFileMode
IFMOffer) (UTCTime -> IO ()) -> IO UTCTime -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO UTCTime
getCurrentTime
  Connection
-> VersionRangeChat
-> User
-> UserId
-> ExceptT StoreError IO AChatItem
getChatItemByFileId Connection
db VersionRangeChat
vr User
user UserId
fileId

startRcvInlineFT :: DB.Connection -> User -> RcvFileTransfer -> FilePath -> Maybe InlineFileMode -> IO ()
startRcvInlineFT :: Connection
-> User
-> RcvFileTransfer
-> FilePath
-> Maybe InlineFileMode
-> IO ()
startRcvInlineFT Connection
db User
user RcvFileTransfer {UserId
fileId :: RcvFileTransfer -> UserId
fileId :: UserId
fileId} FilePath
filePath Maybe InlineFileMode
rcvFileInline =
  Connection
-> User
-> UserId
-> FilePath
-> Bool
-> Maybe InlineFileMode
-> UTCTime
-> IO ()
acceptRcvFT_ Connection
db User
user UserId
fileId FilePath
filePath Bool
False Maybe InlineFileMode
rcvFileInline (UTCTime -> IO ()) -> IO UTCTime -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO UTCTime
getCurrentTime

xftpAcceptRcvFT :: DB.Connection -> VersionRangeChat -> User -> FileTransferId -> FilePath -> Bool -> ExceptT StoreError IO AChatItem
xftpAcceptRcvFT :: Connection
-> VersionRangeChat
-> User
-> UserId
-> FilePath
-> Bool
-> ExceptT StoreError IO AChatItem
xftpAcceptRcvFT Connection
db VersionRangeChat
vr User
user UserId
fileId FilePath
filePath Bool
userApprovedRelays = do
  IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ Connection
-> User
-> UserId
-> FilePath
-> Bool
-> Maybe InlineFileMode
-> UTCTime
-> IO ()
acceptRcvFT_ Connection
db User
user UserId
fileId FilePath
filePath Bool
userApprovedRelays Maybe InlineFileMode
forall a. Maybe a
Nothing (UTCTime -> IO ()) -> IO UTCTime -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO UTCTime
getCurrentTime
  Connection
-> VersionRangeChat
-> User
-> UserId
-> ExceptT StoreError IO AChatItem
getChatItemByFileId Connection
db VersionRangeChat
vr User
user UserId
fileId

acceptRcvFT_ :: DB.Connection -> User -> FileTransferId -> FilePath -> Bool -> Maybe InlineFileMode -> UTCTime -> IO ()
acceptRcvFT_ :: Connection
-> User
-> UserId
-> FilePath
-> Bool
-> Maybe InlineFileMode
-> UTCTime
-> IO ()
acceptRcvFT_ Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} UserId
fileId FilePath
filePath Bool
userApprovedRelays Maybe InlineFileMode
rcvFileInline UTCTime
currentTs = do
  Connection
-> Query
-> (FilePath, CIFileStatus 'MDRcv, UTCTime, UserId, UserId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    Query
"UPDATE files SET file_path = ?, ci_file_status = ?, updated_at = ? WHERE user_id = ? AND file_id = ?"
    (FilePath
filePath, CIFileStatus 'MDRcv
CIFSRcvAccepted, UTCTime
currentTs, UserId
userId, UserId
fileId)
  Connection
-> Query
-> (BoolInt, Maybe InlineFileMode, FileStatus, UTCTime, UserId)
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    Query
"UPDATE rcv_files SET user_approved_relays = ?, rcv_file_inline = ?, file_status = ?, updated_at = ? WHERE file_id = ?"
    (Bool -> BoolInt
BI Bool
userApprovedRelays, Maybe InlineFileMode
rcvFileInline, FileStatus
FSAccepted, UTCTime
currentTs, UserId
fileId)

setRcvFileToReceive :: DB.Connection -> FileTransferId -> Bool -> Maybe CryptoFileArgs -> IO ()
setRcvFileToReceive :: Connection -> UserId -> Bool -> Maybe CryptoFileArgs -> IO ()
setRcvFileToReceive Connection
db UserId
fileId Bool
userApprovedRelays Maybe CryptoFileArgs
cfArgs_ = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  Connection -> Query -> (BoolInt, UTCTime, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE rcv_files
      SET to_receive = 1, user_approved_relays = ?, updated_at = ?
      WHERE file_id = ?
    |]
    (Bool -> BoolInt
BI Bool
userApprovedRelays, UTCTime
currentTs, UserId
fileId)
  Maybe CryptoFileArgs -> (CryptoFileArgs -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe CryptoFileArgs
cfArgs_ ((CryptoFileArgs -> IO ()) -> IO ())
-> (CryptoFileArgs -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CryptoFileArgs
cfArgs -> Connection -> UserId -> CryptoFileArgs -> UTCTime -> IO ()
setFileCryptoArgs_ Connection
db UserId
fileId CryptoFileArgs
cfArgs UTCTime
currentTs

setFileCryptoArgs :: DB.Connection -> FileTransferId -> CryptoFileArgs -> IO ()
setFileCryptoArgs :: Connection -> UserId -> CryptoFileArgs -> IO ()
setFileCryptoArgs Connection
db UserId
fileId CryptoFileArgs
cfArgs = Connection -> UserId -> CryptoFileArgs -> UTCTime -> IO ()
setFileCryptoArgs_ Connection
db UserId
fileId CryptoFileArgs
cfArgs (UTCTime -> IO ()) -> IO UTCTime -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO UTCTime
getCurrentTime

setFileCryptoArgs_ :: DB.Connection -> FileTransferId -> CryptoFileArgs -> UTCTime -> IO ()
setFileCryptoArgs_ :: Connection -> UserId -> CryptoFileArgs -> UTCTime -> IO ()
setFileCryptoArgs_ Connection
db UserId
fileId (CFArgs SbKey
key CbNonce
nonce) UTCTime
currentTs =
  Connection -> Query -> (SbKey, CbNonce, UTCTime, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    Query
"UPDATE files SET file_crypto_key = ?, file_crypto_nonce = ?, updated_at = ? WHERE file_id = ?"
    (SbKey
key, CbNonce
nonce, UTCTime
currentTs, UserId
fileId)

removeFileCryptoArgs :: DB.Connection -> FileTransferId -> IO ()
removeFileCryptoArgs :: Connection -> UserId -> IO ()
removeFileCryptoArgs Connection
db UserId
fileId = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  Connection -> Query -> (UTCTime, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE files SET file_crypto_key = NULL, file_crypto_nonce = NULL, updated_at = ? WHERE file_id = ?" (UTCTime
currentTs, UserId
fileId)

getRcvFilesToReceive :: DB.Connection -> User -> IO [RcvFileTransfer]
getRcvFilesToReceive :: Connection -> User -> IO [RcvFileTransfer]
getRcvFilesToReceive Connection
db user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId} = do
  UTCTime
cutoffTs <- NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (-(NominalDiffTime
2 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
nominalDay)) (UTCTime -> UTCTime) -> IO UTCTime -> IO UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime
  [UserId]
fileIds :: [Int64] <-
    (Only UserId -> UserId) -> [Only UserId] -> [UserId]
forall a b. (a -> b) -> [a] -> [b]
map Only UserId -> UserId
forall a. Only a -> a
fromOnly
      ([Only UserId] -> [UserId]) -> IO [Only UserId] -> IO [UserId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query -> (UserId, FileStatus, UTCTime) -> IO [Only UserId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
        Connection
db
        [sql|
          SELECT r.file_id
          FROM rcv_files r
          JOIN files f ON f.file_id = r.file_id
          WHERE f.user_id = ? AND r.file_status = ?
            AND r.to_receive = 1 AND r.created_at > ?
        |]
        (UserId
userId, FileStatus
FSNew, UTCTime
cutoffTs)
  [Either StoreError RcvFileTransfer] -> [RcvFileTransfer]
forall a b. [Either a b] -> [b]
rights ([Either StoreError RcvFileTransfer] -> [RcvFileTransfer])
-> IO [Either StoreError RcvFileTransfer] -> IO [RcvFileTransfer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (UserId -> IO (Either StoreError RcvFileTransfer))
-> [UserId] -> IO [Either StoreError RcvFileTransfer]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ExceptT StoreError IO RcvFileTransfer
-> IO (Either StoreError RcvFileTransfer)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO RcvFileTransfer
 -> IO (Either StoreError RcvFileTransfer))
-> (UserId -> ExceptT StoreError IO RcvFileTransfer)
-> UserId
-> IO (Either StoreError RcvFileTransfer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection
-> User -> UserId -> ExceptT StoreError IO RcvFileTransfer
getRcvFileTransfer Connection
db User
user) [UserId]
fileIds

setRcvFTAgentDeleted :: DB.Connection -> FileTransferId -> IO ()
setRcvFTAgentDeleted :: Connection -> UserId -> IO ()
setRcvFTAgentDeleted Connection
db UserId
fileId = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  Connection -> Query -> (UTCTime, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    Query
"UPDATE rcv_files SET agent_rcv_file_deleted = 1, updated_at = ? WHERE file_id = ?"
    (UTCTime
currentTs, UserId
fileId)

updateRcvFileStatus :: DB.Connection -> FileTransferId -> FileStatus -> IO ()
updateRcvFileStatus :: Connection -> UserId -> FileStatus -> IO ()
updateRcvFileStatus Connection
db UserId
fileId FileStatus
status = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  Connection -> Query -> (FileStatus, UTCTime, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE rcv_files SET file_status = ?, updated_at = ? WHERE file_id = ?" (FileStatus
status, UTCTime
currentTs, UserId
fileId)

createRcvFileChunk :: DB.Connection -> RcvFileTransfer -> Integer -> AgentMsgId -> IO RcvChunkStatus
createRcvFileChunk :: Connection
-> RcvFileTransfer -> Integer -> UserId -> IO RcvChunkStatus
createRcvFileChunk Connection
db RcvFileTransfer {UserId
fileId :: RcvFileTransfer -> UserId
fileId :: UserId
fileId, fileInvitation :: RcvFileTransfer -> FileInvitation
fileInvitation = FileInvitation {Integer
fileSize :: FileInvitation -> Integer
fileSize :: Integer
fileSize}, Integer
chunkSize :: RcvFileTransfer -> Integer
chunkSize :: Integer
chunkSize} Integer
chunkNo UserId
msgId = do
  RcvChunkStatus
status <- IO RcvChunkStatus
getLastChunkNo
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (RcvChunkStatus
status RcvChunkStatus -> RcvChunkStatus -> Bool
forall a. Eq a => a -> a -> Bool
== RcvChunkStatus
RcvChunkError) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    UTCTime
currentTs <- IO UTCTime
getCurrentTime
    Connection
-> Query -> (UserId, Integer, UserId, UTCTime, UTCTime) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
      Connection
db
      Query
"INSERT OR REPLACE INTO rcv_file_chunks (file_id, chunk_number, chunk_agent_msg_id, created_at, updated_at) VALUES (?,?,?,?,?)"
      (UserId
fileId, Integer
chunkNo, UserId
msgId, UTCTime
currentTs, UTCTime
currentTs)
  RcvChunkStatus -> IO RcvChunkStatus
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RcvChunkStatus
status
  where
    getLastChunkNo :: IO RcvChunkStatus
getLastChunkNo = do
      [Only Integer]
ns <- Connection -> Query -> Only UserId -> IO [Only Integer]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT chunk_number FROM rcv_file_chunks WHERE file_id = ? ORDER BY chunk_number DESC LIMIT 1" (UserId -> Only UserId
forall a. a -> Only a
Only UserId
fileId)
      RcvChunkStatus -> IO RcvChunkStatus
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RcvChunkStatus -> IO RcvChunkStatus)
-> RcvChunkStatus -> IO RcvChunkStatus
forall a b. (a -> b) -> a -> b
$ case (Only Integer -> Integer) -> [Only Integer] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map Only Integer -> Integer
forall a. Only a -> a
fromOnly [Only Integer]
ns of
        []
          | Integer
chunkNo Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 ->
              if Integer
chunkSize Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
fileSize
                then RcvChunkStatus
RcvChunkFinal
                else RcvChunkStatus
RcvChunkOk
          | Bool
otherwise -> RcvChunkStatus
RcvChunkError
        Integer
n : [Integer]
_
          | Integer
chunkNo Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
n -> RcvChunkStatus
RcvChunkDuplicate
          | Integer
chunkNo Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1 ->
              let prevSize :: Integer
prevSize = Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
chunkSize
               in if Integer
prevSize Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
fileSize
                    then RcvChunkStatus
RcvChunkError
                    else
                      if Integer
prevSize Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
chunkSize Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
fileSize
                        then RcvChunkStatus
RcvChunkFinal
                        else RcvChunkStatus
RcvChunkOk
          | Bool
otherwise -> RcvChunkStatus
RcvChunkError

updatedRcvFileChunkStored :: DB.Connection -> RcvFileTransfer -> Integer -> IO ()
updatedRcvFileChunkStored :: Connection -> RcvFileTransfer -> Integer -> IO ()
updatedRcvFileChunkStored Connection
db RcvFileTransfer {UserId
fileId :: RcvFileTransfer -> UserId
fileId :: UserId
fileId} Integer
chunkNo = do
  UTCTime
currentTs <- IO UTCTime
getCurrentTime
  Connection -> Query -> (UTCTime, UserId, Integer) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      UPDATE rcv_file_chunks
      SET chunk_stored = 1, updated_at = ?
      WHERE file_id = ? AND chunk_number = ?
    |]
    (UTCTime
currentTs, UserId
fileId, Integer
chunkNo)

deleteRcvFileChunks :: DB.Connection -> RcvFileTransfer -> IO ()
deleteRcvFileChunks :: Connection -> RcvFileTransfer -> IO ()
deleteRcvFileChunks Connection
db RcvFileTransfer {UserId
fileId :: RcvFileTransfer -> UserId
fileId :: UserId
fileId} =
  Connection -> Query -> Only UserId -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"DELETE FROM rcv_file_chunks WHERE file_id = ?" (UserId -> Only UserId
forall a. a -> Only a
Only UserId
fileId)

updateFileTransferChatItemId :: DB.Connection -> FileTransferId -> ChatItemId -> UTCTime -> IO ()
updateFileTransferChatItemId :: Connection -> UserId -> UserId -> UTCTime -> IO ()
updateFileTransferChatItemId Connection
db UserId
fileId UserId
ciId UTCTime
currentTs =
  Connection -> Query -> (UserId, UTCTime, UserId) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute Connection
db Query
"UPDATE files SET chat_item_id = ?, updated_at = ? WHERE file_id = ?" (UserId
ciId, UTCTime
currentTs, UserId
fileId)

getFileTransferProgress :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO (FileTransfer, [Integer])
getFileTransferProgress :: Connection
-> User
-> UserId
-> ExceptT StoreError IO (FileTransfer, [Integer])
getFileTransferProgress Connection
db User
user UserId
fileId = do
  FileTransfer
ft <- Connection -> User -> UserId -> ExceptT StoreError IO FileTransfer
getFileTransfer Connection
db User
user UserId
fileId
  IO (FileTransfer, [Integer])
-> ExceptT StoreError IO (FileTransfer, [Integer])
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (FileTransfer, [Integer])
 -> ExceptT StoreError IO (FileTransfer, [Integer]))
-> IO (FileTransfer, [Integer])
-> ExceptT StoreError IO (FileTransfer, [Integer])
forall a b. (a -> b) -> a -> b
$
    (FileTransfer
ft,) ([Integer] -> (FileTransfer, [Integer]))
-> ([Only Integer] -> [Integer])
-> [Only Integer]
-> (FileTransfer, [Integer])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Only Integer -> Integer) -> [Only Integer] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map Only Integer -> Integer
forall a. Only a -> a
fromOnly ([Only Integer] -> (FileTransfer, [Integer]))
-> IO [Only Integer] -> IO (FileTransfer, [Integer])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case FileTransfer
ft of
      FTSnd FileTransferMeta
_ [SndFileTransfer]
_ -> [Only Integer] -> IO [Only Integer]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Integer -> Only Integer
forall a. a -> Only a
Only Integer
0]
      FTRcv RcvFileTransfer
_ -> Connection -> Query -> Only UserId -> IO [Only Integer]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT COUNT(*) FROM rcv_file_chunks WHERE file_id = ? AND chunk_stored = 1" (UserId -> Only UserId
forall a. a -> Only a
Only UserId
fileId)

getFileTransfer :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO FileTransfer
getFileTransfer :: Connection -> User -> UserId -> ExceptT StoreError IO FileTransfer
getFileTransfer Connection
db user :: User
user@User {UserId
userId :: User -> UserId
userId :: UserId
userId} UserId
fileId =
  [(Maybe UserId, Maybe UserId, FileProtocol)]
-> ExceptT StoreError IO FileTransfer
fileTransfer ([(Maybe UserId, Maybe UserId, FileProtocol)]
 -> ExceptT StoreError IO FileTransfer)
-> ExceptT
     StoreError IO [(Maybe UserId, Maybe UserId, FileProtocol)]
-> ExceptT StoreError IO FileTransfer
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO [(Maybe UserId, Maybe UserId, FileProtocol)]
-> ExceptT
     StoreError IO [(Maybe UserId, Maybe UserId, FileProtocol)]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Connection
-> UserId
-> UserId
-> IO [(Maybe UserId, Maybe UserId, FileProtocol)]
getFileTransferRow_ Connection
db UserId
userId UserId
fileId)
  where
    fileTransfer :: [(Maybe Int64, Maybe Int64, FileProtocol)] -> ExceptT StoreError IO FileTransfer
    fileTransfer :: [(Maybe UserId, Maybe UserId, FileProtocol)]
-> ExceptT StoreError IO FileTransfer
fileTransfer [(Maybe UserId
_, Maybe UserId
_, FileProtocol
FPLocal)] = StoreError -> ExceptT StoreError IO FileTransfer
forall a. StoreError -> ExceptT StoreError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (StoreError -> ExceptT StoreError IO FileTransfer)
-> StoreError -> ExceptT StoreError IO FileTransfer
forall a b. (a -> b) -> a -> b
$ UserId -> StoreError
SELocalFileNoTransfer UserId
fileId
    fileTransfer [(Maybe UserId
Nothing, Just UserId
_, FileProtocol
_)] = RcvFileTransfer -> FileTransfer
FTRcv (RcvFileTransfer -> FileTransfer)
-> ExceptT StoreError IO RcvFileTransfer
-> ExceptT StoreError IO FileTransfer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> User -> UserId -> ExceptT StoreError IO RcvFileTransfer
getRcvFileTransfer Connection
db User
user UserId
fileId
    fileTransfer [(Maybe UserId, Maybe UserId, FileProtocol)]
_ = do
      (FileTransferMeta
ftm, [SndFileTransfer]
fts) <- Connection
-> User
-> UserId
-> ExceptT StoreError IO (FileTransferMeta, [SndFileTransfer])
getSndFileTransfer Connection
db User
user UserId
fileId
      FileTransfer -> ExceptT StoreError IO FileTransfer
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FileTransfer -> ExceptT StoreError IO FileTransfer)
-> FileTransfer -> ExceptT StoreError IO FileTransfer
forall a b. (a -> b) -> a -> b
$ FTSnd {fileTransferMeta :: FileTransferMeta
fileTransferMeta = FileTransferMeta
ftm, sndFileTransfers :: [SndFileTransfer]
sndFileTransfers = [SndFileTransfer]
fts}

getFileTransferRow_ :: DB.Connection -> UserId -> Int64 -> IO [(Maybe Int64, Maybe Int64, FileProtocol)]
getFileTransferRow_ :: Connection
-> UserId
-> UserId
-> IO [(Maybe UserId, Maybe UserId, FileProtocol)]
getFileTransferRow_ Connection
db UserId
userId UserId
fileId =
  Connection
-> Query
-> (UserId, UserId)
-> IO [(Maybe UserId, Maybe UserId, FileProtocol)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
    Connection
db
    [sql|
      SELECT s.file_id, r.file_id, f.protocol
      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
userId, UserId
fileId)

getSndFileTransfer :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO (FileTransferMeta, [SndFileTransfer])
getSndFileTransfer :: Connection
-> User
-> UserId
-> ExceptT StoreError IO (FileTransferMeta, [SndFileTransfer])
getSndFileTransfer Connection
db User
user UserId
fileId = do
  FileTransferMeta
fileTransferMeta <- Connection
-> User -> UserId -> ExceptT StoreError IO FileTransferMeta
getFileTransferMeta Connection
db User
user UserId
fileId
  [SndFileTransfer]
sndFileTransfers <- Connection
-> User -> UserId -> ExceptT StoreError IO [SndFileTransfer]
getSndFileTransfers Connection
db User
user UserId
fileId
  (FileTransferMeta, [SndFileTransfer])
-> ExceptT StoreError IO (FileTransferMeta, [SndFileTransfer])
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FileTransferMeta
fileTransferMeta, [SndFileTransfer]
sndFileTransfers)

getSndFileTransfers :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO [SndFileTransfer]
getSndFileTransfers :: Connection
-> User -> UserId -> ExceptT StoreError IO [SndFileTransfer]
getSndFileTransfers Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} UserId
fileId = IO (Either StoreError [SndFileTransfer])
-> ExceptT StoreError IO [SndFileTransfer]
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError [SndFileTransfer])
 -> ExceptT StoreError IO [SndFileTransfer])
-> IO (Either StoreError [SndFileTransfer])
-> ExceptT StoreError IO [SndFileTransfer]
forall a b. (a -> b) -> a -> b
$ Connection
-> UserId -> UserId -> IO (Either StoreError [SndFileTransfer])
getSndFileTransfers_ Connection
db UserId
userId UserId
fileId

getSndFileTransfers_ :: DB.Connection -> UserId -> Int64 -> IO (Either StoreError [SndFileTransfer])
getSndFileTransfers_ :: Connection
-> UserId -> UserId -> IO (Either StoreError [SndFileTransfer])
getSndFileTransfers_ Connection
db UserId
userId UserId
fileId =
  (((FileStatus, FilePath, Integer, Integer, FilePath)
  :. (Maybe UserId, Maybe InlineFileMode, UserId, AgentConnId,
      Maybe UserId, Maybe Text, Maybe Text))
 -> Either StoreError SndFileTransfer)
-> [(FileStatus, FilePath, Integer, Integer, FilePath)
    :. (Maybe UserId, Maybe InlineFileMode, UserId, AgentConnId,
        Maybe UserId, Maybe Text, Maybe Text)]
-> Either StoreError [SndFileTransfer]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((FileStatus, FilePath, Integer, Integer, FilePath)
 :. (Maybe UserId, Maybe InlineFileMode, UserId, AgentConnId,
     Maybe UserId, Maybe Text, Maybe Text))
-> Either StoreError SndFileTransfer
sndFileTransfer
    ([(FileStatus, FilePath, Integer, Integer, FilePath)
  :. (Maybe UserId, Maybe InlineFileMode, UserId, AgentConnId,
      Maybe UserId, Maybe Text, Maybe Text)]
 -> Either StoreError [SndFileTransfer])
-> IO
     [(FileStatus, FilePath, Integer, Integer, FilePath)
      :. (Maybe UserId, Maybe InlineFileMode, UserId, AgentConnId,
          Maybe UserId, Maybe Text, Maybe Text)]
-> IO (Either StoreError [SndFileTransfer])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (UserId, UserId)
-> IO
     [(FileStatus, FilePath, Integer, Integer, FilePath)
      :. (Maybe UserId, Maybe InlineFileMode, UserId, AgentConnId,
          Maybe UserId, Maybe Text, Maybe Text)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT s.file_status, f.file_name, f.file_size, f.chunk_size, f.file_path, s.file_descr_id, s.file_inline, s.connection_id, c.agent_conn_id, s.group_member_id,
          cs.local_display_name, m.local_display_name
        FROM snd_files s
        JOIN files f USING (file_id)
        JOIN connections c USING (connection_id)
        LEFT JOIN contacts cs ON cs.contact_id = f.contact_id
        LEFT JOIN group_members m ON m.group_member_id = s.group_member_id
        WHERE f.user_id = ? AND f.file_id = ?
      |]
      (UserId
userId, UserId
fileId)
  where
    sndFileTransfer :: (FileStatus, String, Integer, Integer, FilePath) :. (Maybe Int64, Maybe InlineFileMode, Int64, AgentConnId, Maybe Int64, Maybe ContactName, Maybe ContactName) -> Either StoreError SndFileTransfer
    sndFileTransfer :: ((FileStatus, FilePath, Integer, Integer, FilePath)
 :. (Maybe UserId, Maybe InlineFileMode, UserId, AgentConnId,
     Maybe UserId, Maybe Text, Maybe Text))
-> Either StoreError SndFileTransfer
sndFileTransfer ((FileStatus
fileStatus, FilePath
fileName, Integer
fileSize, Integer
chunkSize, FilePath
filePath) :. (Maybe UserId
fileDescrId, Maybe InlineFileMode
fileInline, UserId
connId, AgentConnId
agentConnId, Maybe UserId
groupMemberId, Maybe Text
contactName_, Maybe Text
memberName_)) =
      case Maybe Text
contactName_ Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
memberName_ of
        Just Text
recipientDisplayName -> SndFileTransfer -> Either StoreError SndFileTransfer
forall a b. b -> Either a b
Right SndFileTransfer {UserId
fileId :: UserId
fileId :: UserId
fileId, FileStatus
fileStatus :: FileStatus
fileStatus :: FileStatus
fileStatus, FilePath
fileName :: FilePath
fileName :: FilePath
fileName, Integer
fileSize :: Integer
fileSize :: Integer
fileSize, Integer
chunkSize :: Integer
chunkSize :: Integer
chunkSize, FilePath
filePath :: FilePath
filePath :: FilePath
filePath, Maybe UserId
fileDescrId :: Maybe UserId
fileDescrId :: Maybe UserId
fileDescrId, Maybe InlineFileMode
fileInline :: Maybe InlineFileMode
fileInline :: Maybe InlineFileMode
fileInline, Text
recipientDisplayName :: Text
recipientDisplayName :: Text
recipientDisplayName, UserId
connId :: UserId
connId :: UserId
connId, AgentConnId
agentConnId :: AgentConnId
agentConnId :: AgentConnId
agentConnId, Maybe UserId
groupMemberId :: Maybe UserId
groupMemberId :: Maybe UserId
groupMemberId}
        Maybe Text
Nothing -> StoreError -> Either StoreError SndFileTransfer
forall a b. a -> Either a b
Left (StoreError -> Either StoreError SndFileTransfer)
-> StoreError -> Either StoreError SndFileTransfer
forall a b. (a -> b) -> a -> b
$ UserId -> StoreError
SESndFileInvalid UserId
fileId

getFileTransferMeta :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO FileTransferMeta
getFileTransferMeta :: Connection
-> User -> UserId -> ExceptT StoreError IO FileTransferMeta
getFileTransferMeta Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} = Connection
-> UserId -> UserId -> ExceptT StoreError IO FileTransferMeta
getFileTransferMeta_ Connection
db UserId
userId

getFileTransferMeta_ :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO FileTransferMeta
getFileTransferMeta_ :: Connection
-> UserId -> UserId -> ExceptT StoreError IO FileTransferMeta
getFileTransferMeta_ Connection
db UserId
userId UserId
fileId =
  IO (Either StoreError FileTransferMeta)
-> ExceptT StoreError IO FileTransferMeta
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError FileTransferMeta)
 -> ExceptT StoreError IO FileTransferMeta)
-> (IO
      [(FilePath, Integer, Integer, FilePath, Maybe SbKey, Maybe CbNonce,
        Maybe InlineFileMode, Maybe AgentSndFileId, BoolInt, Maybe Text,
        Maybe BoolInt, Maybe UserId)]
    -> IO (Either StoreError FileTransferMeta))
-> IO
     [(FilePath, Integer, Integer, FilePath, Maybe SbKey, Maybe CbNonce,
       Maybe InlineFileMode, Maybe AgentSndFileId, BoolInt, Maybe Text,
       Maybe BoolInt, Maybe UserId)]
-> ExceptT StoreError IO FileTransferMeta
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FilePath, Integer, Integer, FilePath, Maybe SbKey, Maybe CbNonce,
  Maybe InlineFileMode, Maybe AgentSndFileId, BoolInt, Maybe Text,
  Maybe BoolInt, Maybe UserId)
 -> FileTransferMeta)
-> StoreError
-> IO
     [(FilePath, Integer, Integer, FilePath, Maybe SbKey, Maybe CbNonce,
       Maybe InlineFileMode, Maybe AgentSndFileId, BoolInt, Maybe Text,
       Maybe BoolInt, Maybe UserId)]
-> IO (Either StoreError FileTransferMeta)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow (FilePath, Integer, Integer, FilePath, Maybe SbKey, Maybe CbNonce,
 Maybe InlineFileMode, Maybe AgentSndFileId, BoolInt, Maybe Text,
 Maybe BoolInt, Maybe UserId)
-> FileTransferMeta
fileTransferMeta (UserId -> StoreError
SEFileNotFound UserId
fileId) (IO
   [(FilePath, Integer, Integer, FilePath, Maybe SbKey, Maybe CbNonce,
     Maybe InlineFileMode, Maybe AgentSndFileId, BoolInt, Maybe Text,
     Maybe BoolInt, Maybe UserId)]
 -> ExceptT StoreError IO FileTransferMeta)
-> IO
     [(FilePath, Integer, Integer, FilePath, Maybe SbKey, Maybe CbNonce,
       Maybe InlineFileMode, Maybe AgentSndFileId, BoolInt, Maybe Text,
       Maybe BoolInt, Maybe UserId)]
-> ExceptT StoreError IO FileTransferMeta
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> (UserId, UserId)
-> IO
     [(FilePath, Integer, Integer, FilePath, Maybe SbKey, Maybe CbNonce,
       Maybe InlineFileMode, Maybe AgentSndFileId, BoolInt, Maybe Text,
       Maybe BoolInt, Maybe UserId)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT file_name, file_size, chunk_size, file_path, file_crypto_key, file_crypto_nonce, file_inline, agent_snd_file_id, agent_snd_file_deleted, private_snd_file_descr, cancelled, redirect_file_id
        FROM files
        WHERE user_id = ? AND file_id = ?
      |]
      (UserId
userId, UserId
fileId)
  where
    fileTransferMeta :: (String, Integer, Integer, FilePath, Maybe C.SbKey, Maybe C.CbNonce, Maybe InlineFileMode, Maybe AgentSndFileId, BoolInt, Maybe Text, Maybe BoolInt, Maybe FileTransferId) -> FileTransferMeta
    fileTransferMeta :: (FilePath, Integer, Integer, FilePath, Maybe SbKey, Maybe CbNonce,
 Maybe InlineFileMode, Maybe AgentSndFileId, BoolInt, Maybe Text,
 Maybe BoolInt, Maybe UserId)
-> FileTransferMeta
fileTransferMeta (FilePath
fileName, Integer
fileSize, Integer
chunkSize, FilePath
filePath, Maybe SbKey
fileKey, Maybe CbNonce
fileNonce, Maybe InlineFileMode
fileInline, Maybe AgentSndFileId
aSndFileId_, BI Bool
agentSndFileDeleted, Maybe Text
privateSndFileDescr, Maybe BoolInt
cancelled_, Maybe UserId
xftpRedirectFor) =
      let cryptoArgs :: Maybe CryptoFileArgs
cryptoArgs = SbKey -> CbNonce -> CryptoFileArgs
CFArgs (SbKey -> CbNonce -> CryptoFileArgs)
-> Maybe SbKey -> Maybe (CbNonce -> CryptoFileArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SbKey
fileKey Maybe (CbNonce -> CryptoFileArgs)
-> Maybe CbNonce -> Maybe CryptoFileArgs
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe CbNonce
fileNonce
          xftpSndFile :: Maybe XFTPSndFile
xftpSndFile = (\AgentSndFileId
fId -> XFTPSndFile {agentSndFileId :: AgentSndFileId
agentSndFileId = AgentSndFileId
fId, Maybe Text
privateSndFileDescr :: Maybe Text
privateSndFileDescr :: Maybe Text
privateSndFileDescr, Bool
agentSndFileDeleted :: Bool
agentSndFileDeleted :: Bool
agentSndFileDeleted, Maybe CryptoFileArgs
cryptoArgs :: Maybe CryptoFileArgs
cryptoArgs :: Maybe CryptoFileArgs
cryptoArgs}) (AgentSndFileId -> XFTPSndFile)
-> Maybe AgentSndFileId -> Maybe XFTPSndFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe AgentSndFileId
aSndFileId_
       in FileTransferMeta {UserId
fileId :: UserId
fileId :: UserId
fileId, Maybe XFTPSndFile
xftpSndFile :: Maybe XFTPSndFile
xftpSndFile :: Maybe XFTPSndFile
xftpSndFile, Maybe UserId
xftpRedirectFor :: Maybe UserId
xftpRedirectFor :: Maybe UserId
xftpRedirectFor, FilePath
fileName :: FilePath
fileName :: FilePath
fileName, Integer
fileSize :: Integer
fileSize :: Integer
fileSize, Integer
chunkSize :: Integer
chunkSize :: Integer
chunkSize, FilePath
filePath :: FilePath
filePath :: FilePath
filePath, Maybe InlineFileMode
fileInline :: Maybe InlineFileMode
fileInline :: Maybe InlineFileMode
fileInline, cancelled :: Bool
cancelled = Bool -> (BoolInt -> Bool) -> Maybe BoolInt -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False BoolInt -> Bool
unBI Maybe BoolInt
cancelled_}

lookupFileTransferRedirectMeta :: DB.Connection -> User -> Int64 -> IO [FileTransferMeta]
lookupFileTransferRedirectMeta :: Connection -> User -> UserId -> IO [FileTransferMeta]
lookupFileTransferRedirectMeta Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} UserId
fileId = do
  [Only UserId]
redirects <- Connection -> Query -> (UserId, UserId) -> IO [Only UserId]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db Query
"SELECT file_id FROM files WHERE user_id = ? AND redirect_file_id = ?" (UserId
userId, UserId
fileId)
  [Either StoreError FileTransferMeta] -> [FileTransferMeta]
forall a b. [Either a b] -> [b]
rights ([Either StoreError FileTransferMeta] -> [FileTransferMeta])
-> IO [Either StoreError FileTransferMeta] -> IO [FileTransferMeta]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Only UserId -> IO (Either StoreError FileTransferMeta))
-> [Only UserId] -> IO [Either StoreError FileTransferMeta]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ExceptT StoreError IO FileTransferMeta
-> IO (Either StoreError FileTransferMeta)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO FileTransferMeta
 -> IO (Either StoreError FileTransferMeta))
-> (Only UserId -> ExceptT StoreError IO FileTransferMeta)
-> Only UserId
-> IO (Either StoreError FileTransferMeta)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection
-> UserId -> UserId -> ExceptT StoreError IO FileTransferMeta
getFileTransferMeta_ Connection
db UserId
userId (UserId -> ExceptT StoreError IO FileTransferMeta)
-> (Only UserId -> UserId)
-> Only UserId
-> ExceptT StoreError IO FileTransferMeta
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Only UserId -> UserId
forall a. Only a -> a
fromOnly) [Only UserId]
redirects

createLocalFile :: ToField (CIFileStatus d) => CIFileStatus d -> DB.Connection -> User -> NoteFolder -> UTCTime -> CryptoFile -> Integer -> Integer -> IO Int64
createLocalFile :: forall (d :: MsgDirection).
ToField (CIFileStatus d) =>
CIFileStatus d
-> Connection
-> User
-> NoteFolder
-> UTCTime
-> CryptoFile
-> Integer
-> Integer
-> IO UserId
createLocalFile CIFileStatus d
fileStatus Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} NoteFolder {UserId
noteFolderId :: UserId
noteFolderId :: NoteFolder -> UserId
noteFolderId} UTCTime
itemTs CryptoFile {FilePath
filePath :: FilePath
filePath :: CryptoFile -> FilePath
filePath, Maybe CryptoFileArgs
cryptoArgs :: Maybe CryptoFileArgs
cryptoArgs :: CryptoFile -> Maybe CryptoFileArgs
cryptoArgs} Integer
fileSize Integer
fileChunkSize = do
  Connection
-> Query
-> ((UserId, UserId)
    :. ((FilePath, FilePath, Integer)
        :. ((Maybe SbKey, Maybe CbNonce)
            :. (Integer, Maybe InlineFileMode, CIFileStatus d, FileProtocol,
                UTCTime, UTCTime))))
-> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
DB.execute
    Connection
db
    [sql|
      INSERT INTO files
        ( user_id, note_folder_id,
          file_name, file_path, file_size,
          file_crypto_key, file_crypto_nonce,
          chunk_size, file_inline, ci_file_status, protocol, created_at, updated_at
        )
      VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)
    |]
    ( (UserId
userId, UserId
noteFolderId)
        (UserId, UserId)
-> ((FilePath, FilePath, Integer)
    :. ((Maybe SbKey, Maybe CbNonce)
        :. (Integer, Maybe InlineFileMode, CIFileStatus d, FileProtocol,
            UTCTime, UTCTime)))
-> (UserId, UserId)
   :. ((FilePath, FilePath, Integer)
       :. ((Maybe SbKey, Maybe CbNonce)
           :. (Integer, Maybe InlineFileMode, CIFileStatus d, FileProtocol,
               UTCTime, UTCTime)))
forall h t. h -> t -> h :. t
:. (FilePath -> FilePath
takeFileName FilePath
filePath, FilePath
filePath, Integer
fileSize)
        (FilePath, FilePath, Integer)
-> ((Maybe SbKey, Maybe CbNonce)
    :. (Integer, Maybe InlineFileMode, CIFileStatus d, FileProtocol,
        UTCTime, UTCTime))
-> (FilePath, FilePath, Integer)
   :. ((Maybe SbKey, Maybe CbNonce)
       :. (Integer, Maybe InlineFileMode, CIFileStatus d, FileProtocol,
           UTCTime, UTCTime))
forall h t. h -> t -> h :. t
:. (Maybe SbKey, Maybe CbNonce)
-> (CryptoFileArgs -> (Maybe SbKey, Maybe CbNonce))
-> Maybe CryptoFileArgs
-> (Maybe SbKey, Maybe CbNonce)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe SbKey
forall a. Maybe a
Nothing, Maybe CbNonce
forall a. Maybe a
Nothing) (\(CFArgs SbKey
key CbNonce
nonce) -> (SbKey -> Maybe SbKey
forall a. a -> Maybe a
Just SbKey
key, CbNonce -> Maybe CbNonce
forall a. a -> Maybe a
Just CbNonce
nonce)) Maybe CryptoFileArgs
cryptoArgs
        (Maybe SbKey, Maybe CbNonce)
-> (Integer, Maybe InlineFileMode, CIFileStatus d, FileProtocol,
    UTCTime, UTCTime)
-> (Maybe SbKey, Maybe CbNonce)
   :. (Integer, Maybe InlineFileMode, CIFileStatus d, FileProtocol,
       UTCTime, UTCTime)
forall h t. h -> t -> h :. t
:. (Integer
fileChunkSize, Maybe InlineFileMode
forall a. Maybe a
Nothing :: Maybe InlineFileMode, CIFileStatus d
fileStatus, FileProtocol
FPLocal, UTCTime
itemTs, UTCTime
itemTs)
    )
  Connection -> IO UserId
insertedRowId Connection
db

getLocalFileMeta :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO LocalFileMeta
getLocalFileMeta :: Connection
-> UserId -> UserId -> ExceptT StoreError IO LocalFileMeta
getLocalFileMeta Connection
db UserId
userId UserId
fileId =
  IO (Either StoreError LocalFileMeta)
-> ExceptT StoreError IO LocalFileMeta
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either StoreError LocalFileMeta)
 -> ExceptT StoreError IO LocalFileMeta)
-> (IO [(FilePath, Integer, FilePath, Maybe SbKey, Maybe CbNonce)]
    -> IO (Either StoreError LocalFileMeta))
-> IO [(FilePath, Integer, FilePath, Maybe SbKey, Maybe CbNonce)]
-> ExceptT StoreError IO LocalFileMeta
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FilePath, Integer, FilePath, Maybe SbKey, Maybe CbNonce)
 -> LocalFileMeta)
-> StoreError
-> IO [(FilePath, Integer, FilePath, Maybe SbKey, Maybe CbNonce)]
-> IO (Either StoreError LocalFileMeta)
forall a b e. (a -> b) -> e -> IO [a] -> IO (Either e b)
firstRow (FilePath, Integer, FilePath, Maybe SbKey, Maybe CbNonce)
-> LocalFileMeta
localFileMeta (UserId -> StoreError
SEFileNotFound UserId
fileId) (IO [(FilePath, Integer, FilePath, Maybe SbKey, Maybe CbNonce)]
 -> ExceptT StoreError IO LocalFileMeta)
-> IO [(FilePath, Integer, FilePath, Maybe SbKey, Maybe CbNonce)]
-> ExceptT StoreError IO LocalFileMeta
forall a b. (a -> b) -> a -> b
$
    Connection
-> Query
-> (UserId, UserId)
-> IO [(FilePath, Integer, FilePath, Maybe SbKey, Maybe CbNonce)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query
      Connection
db
      [sql|
        SELECT file_name, file_size, file_path, file_crypto_key, file_crypto_nonce
        FROM files
        WHERE user_id = ? AND file_id = ?
      |]
      (UserId
userId, UserId
fileId)
  where
    localFileMeta :: (FilePath, Integer, FilePath, Maybe C.SbKey, Maybe C.CbNonce) -> LocalFileMeta
    localFileMeta :: (FilePath, Integer, FilePath, Maybe SbKey, Maybe CbNonce)
-> LocalFileMeta
localFileMeta (FilePath
fileName, Integer
fileSize, FilePath
filePath, Maybe SbKey
fileKey, Maybe CbNonce
fileNonce) =
      let fileCryptoArgs :: Maybe CryptoFileArgs
fileCryptoArgs = SbKey -> CbNonce -> CryptoFileArgs
CFArgs (SbKey -> CbNonce -> CryptoFileArgs)
-> Maybe SbKey -> Maybe (CbNonce -> CryptoFileArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SbKey
fileKey Maybe (CbNonce -> CryptoFileArgs)
-> Maybe CbNonce -> Maybe CryptoFileArgs
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe CbNonce
fileNonce
       in LocalFileMeta {UserId
fileId :: UserId
fileId :: UserId
fileId, FilePath
fileName :: FilePath
fileName :: FilePath
fileName, Integer
fileSize :: Integer
fileSize :: Integer
fileSize, FilePath
filePath :: FilePath
filePath :: FilePath
filePath, Maybe CryptoFileArgs
fileCryptoArgs :: Maybe CryptoFileArgs
fileCryptoArgs :: Maybe CryptoFileArgs
fileCryptoArgs}

getContactFileInfo :: DB.Connection -> User -> Contact -> IO [CIFileInfo]
getContactFileInfo :: Connection -> User -> Contact -> IO [CIFileInfo]
getContactFileInfo Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} Contact {UserId
contactId :: Contact -> UserId
contactId :: UserId
contactId} =
  ((UserId, Maybe ACIFileStatus, Maybe FilePath) -> CIFileInfo)
-> [(UserId, Maybe ACIFileStatus, Maybe FilePath)] -> [CIFileInfo]
forall a b. (a -> b) -> [a] -> [b]
map (UserId, Maybe ACIFileStatus, Maybe FilePath) -> CIFileInfo
toFileInfo
    ([(UserId, Maybe ACIFileStatus, Maybe FilePath)] -> [CIFileInfo])
-> IO [(UserId, Maybe ACIFileStatus, Maybe FilePath)]
-> IO [CIFileInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (UserId, UserId)
-> IO [(UserId, Maybe ACIFileStatus, Maybe FilePath)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db (Query
fileInfoQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" WHERE i.user_id = ? AND i.contact_id = ?") (UserId
userId, UserId
contactId)

getNoteFolderFileInfo :: DB.Connection -> User -> NoteFolder -> IO [CIFileInfo]
getNoteFolderFileInfo :: Connection -> User -> NoteFolder -> IO [CIFileInfo]
getNoteFolderFileInfo Connection
db User {UserId
userId :: User -> UserId
userId :: UserId
userId} NoteFolder {UserId
noteFolderId :: NoteFolder -> UserId
noteFolderId :: UserId
noteFolderId} =
  ((UserId, Maybe ACIFileStatus, Maybe FilePath) -> CIFileInfo)
-> [(UserId, Maybe ACIFileStatus, Maybe FilePath)] -> [CIFileInfo]
forall a b. (a -> b) -> [a] -> [b]
map (UserId, Maybe ACIFileStatus, Maybe FilePath) -> CIFileInfo
toFileInfo
    ([(UserId, Maybe ACIFileStatus, Maybe FilePath)] -> [CIFileInfo])
-> IO [(UserId, Maybe ACIFileStatus, Maybe FilePath)]
-> IO [CIFileInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> Query
-> (UserId, UserId)
-> IO [(UserId, Maybe ACIFileStatus, Maybe FilePath)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
DB.query Connection
db (Query
fileInfoQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
" WHERE i.user_id = ? AND i.note_folder_id = ?") (UserId
userId, UserId
noteFolderId)

getLocalCryptoFile :: DB.Connection -> UserId -> Int64 -> Bool -> ExceptT StoreError IO CryptoFile
getLocalCryptoFile :: Connection
-> UserId -> UserId -> Bool -> ExceptT StoreError IO CryptoFile
getLocalCryptoFile Connection
db UserId
userId UserId
fileId Bool
sent =
  IO [(Maybe UserId, Maybe UserId, FileProtocol)]
-> ExceptT
     StoreError IO [(Maybe UserId, Maybe UserId, FileProtocol)]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Connection
-> UserId
-> UserId
-> IO [(Maybe UserId, Maybe UserId, FileProtocol)]
getFileTransferRow_ Connection
db UserId
userId UserId
fileId) ExceptT StoreError IO [(Maybe UserId, Maybe UserId, FileProtocol)]
-> ([(Maybe UserId, Maybe UserId, FileProtocol)]
    -> ExceptT StoreError IO CryptoFile)
-> ExceptT StoreError IO CryptoFile
forall a b.
ExceptT StoreError IO a
-> (a -> ExceptT StoreError IO b) -> ExceptT StoreError IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    [(Maybe UserId
Nothing, Just UserId
_, FileProtocol
_)] -> do
      Bool -> ExceptT StoreError IO () -> ExceptT StoreError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
sent (ExceptT StoreError IO () -> ExceptT StoreError IO ())
-> ExceptT StoreError IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ StoreError -> ExceptT StoreError IO ()
forall a. StoreError -> ExceptT StoreError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (StoreError -> ExceptT StoreError IO ())
-> StoreError -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ UserId -> StoreError
SEFileNotFound UserId
fileId
      RcvFileTransfer {RcvFileStatus
fileStatus :: RcvFileTransfer -> RcvFileStatus
fileStatus :: RcvFileStatus
fileStatus, Maybe CryptoFileArgs
cryptoArgs :: RcvFileTransfer -> Maybe CryptoFileArgs
cryptoArgs :: Maybe CryptoFileArgs
cryptoArgs} <- Connection
-> UserId -> UserId -> ExceptT StoreError IO RcvFileTransfer
getRcvFileTransfer_ Connection
db UserId
userId UserId
fileId
      case RcvFileStatus
fileStatus of
        RFSComplete FilePath
filePath -> CryptoFile -> ExceptT StoreError IO CryptoFile
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CryptoFile -> ExceptT StoreError IO CryptoFile)
-> CryptoFile -> ExceptT StoreError IO CryptoFile
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe CryptoFileArgs -> CryptoFile
CryptoFile FilePath
filePath Maybe CryptoFileArgs
cryptoArgs
        RcvFileStatus
_ -> StoreError -> ExceptT StoreError IO CryptoFile
forall a. StoreError -> ExceptT StoreError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (StoreError -> ExceptT StoreError IO CryptoFile)
-> StoreError -> ExceptT StoreError IO CryptoFile
forall a b. (a -> b) -> a -> b
$ UserId -> StoreError
SEFileNotFound UserId
fileId
    [(Just UserId
_, Maybe UserId
Nothing, FileProtocol
_)] -> do
      Bool -> ExceptT StoreError IO () -> ExceptT StoreError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
sent (ExceptT StoreError IO () -> ExceptT StoreError IO ())
-> ExceptT StoreError IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ StoreError -> ExceptT StoreError IO ()
forall a. StoreError -> ExceptT StoreError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (StoreError -> ExceptT StoreError IO ())
-> StoreError -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ UserId -> StoreError
SEFileNotFound UserId
fileId
      FileTransferMeta {FilePath
filePath :: FileTransferMeta -> FilePath
filePath :: FilePath
filePath, Maybe XFTPSndFile
xftpSndFile :: FileTransferMeta -> Maybe XFTPSndFile
xftpSndFile :: Maybe XFTPSndFile
xftpSndFile} <- Connection
-> UserId -> UserId -> ExceptT StoreError IO FileTransferMeta
getFileTransferMeta_ Connection
db UserId
userId UserId
fileId
      CryptoFile -> ExceptT StoreError IO CryptoFile
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CryptoFile -> ExceptT StoreError IO CryptoFile)
-> CryptoFile -> ExceptT StoreError IO CryptoFile
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe CryptoFileArgs -> CryptoFile
CryptoFile FilePath
filePath (Maybe CryptoFileArgs -> CryptoFile)
-> Maybe CryptoFileArgs -> CryptoFile
forall a b. (a -> b) -> a -> b
$ Maybe XFTPSndFile
xftpSndFile Maybe XFTPSndFile
-> (XFTPSndFile -> Maybe CryptoFileArgs) -> Maybe CryptoFileArgs
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \XFTPSndFile {Maybe CryptoFileArgs
cryptoArgs :: XFTPSndFile -> Maybe CryptoFileArgs
cryptoArgs :: Maybe CryptoFileArgs
cryptoArgs} -> Maybe CryptoFileArgs
cryptoArgs
    [(Maybe UserId
Nothing, Maybe UserId
Nothing, FileProtocol
FPLocal)] -> do
      LocalFileMeta {FilePath
filePath :: LocalFileMeta -> FilePath
filePath :: FilePath
filePath, Maybe CryptoFileArgs
fileCryptoArgs :: LocalFileMeta -> Maybe CryptoFileArgs
fileCryptoArgs :: Maybe CryptoFileArgs
fileCryptoArgs} <- Connection
-> UserId -> UserId -> ExceptT StoreError IO LocalFileMeta
getLocalFileMeta Connection
db UserId
userId UserId
fileId
      CryptoFile -> ExceptT StoreError IO CryptoFile
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CryptoFile -> ExceptT StoreError IO CryptoFile)
-> CryptoFile -> ExceptT StoreError IO CryptoFile
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe CryptoFileArgs -> CryptoFile
CryptoFile FilePath
filePath Maybe CryptoFileArgs
fileCryptoArgs
    [(Maybe UserId, Maybe UserId, FileProtocol)]
_ -> StoreError -> ExceptT StoreError IO CryptoFile
forall a. StoreError -> ExceptT StoreError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (StoreError -> ExceptT StoreError IO CryptoFile)
-> StoreError -> ExceptT StoreError IO CryptoFile
forall a b. (a -> b) -> a -> b
$ UserId -> StoreError
SEFileNotFound UserId
fileId

updateDirectCIFileStatus :: forall d. MsgDirectionI d => DB.Connection -> VersionRangeChat -> User -> Int64 -> CIFileStatus d -> ExceptT StoreError IO AChatItem
updateDirectCIFileStatus :: forall (d :: MsgDirection).
MsgDirectionI d =>
Connection
-> VersionRangeChat
-> User
-> UserId
-> CIFileStatus d
-> ExceptT StoreError IO AChatItem
updateDirectCIFileStatus Connection
db VersionRangeChat
vr User
user UserId
fileId CIFileStatus d
fileStatus = do
  aci :: AChatItem
aci@(AChatItem SChatType c
cType SMsgDirection d
d ChatInfo c
cInfo ChatItem c d
ci) <- Connection
-> VersionRangeChat
-> User
-> UserId
-> ExceptT StoreError IO AChatItem
getChatItemByFileId Connection
db VersionRangeChat
vr User
user UserId
fileId
  case (SChatType c
cType, SMsgDirection d -> SMsgDirection d -> Maybe (d :~: d)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: MsgDirection) (b :: MsgDirection).
SMsgDirection a -> SMsgDirection b -> Maybe (a :~: b)
testEquality SMsgDirection d
d (SMsgDirection d -> Maybe (d :~: d))
-> SMsgDirection d -> Maybe (d :~: d)
forall a b. (a -> b) -> a -> b
$ forall (d :: MsgDirection). MsgDirectionI d => SMsgDirection d
msgDirection @d) of
    (SChatType c
SCTDirect, Just d :~: d
Refl) -> do
      IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> User -> UserId -> CIFileStatus d -> IO ()
forall (d :: MsgDirection).
MsgDirectionI d =>
Connection -> User -> UserId -> CIFileStatus d -> IO ()
updateCIFileStatus Connection
db User
user UserId
fileId CIFileStatus d
fileStatus
      AChatItem -> ExceptT StoreError IO AChatItem
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AChatItem -> ExceptT StoreError IO AChatItem)
-> AChatItem -> ExceptT StoreError IO AChatItem
forall a b. (a -> b) -> a -> b
$ SChatType 'CTDirect
-> SMsgDirection d
-> ChatInfo 'CTDirect
-> ChatItem 'CTDirect d
-> AChatItem
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
SChatType c
-> SMsgDirection d -> ChatInfo c -> ChatItem c d -> AChatItem
AChatItem SChatType 'CTDirect
SCTDirect SMsgDirection d
d ChatInfo c
ChatInfo 'CTDirect
cInfo (ChatItem 'CTDirect d -> AChatItem)
-> ChatItem 'CTDirect d -> AChatItem
forall a b. (a -> b) -> a -> b
$ ChatItem 'CTDirect d -> CIFileStatus d -> ChatItem 'CTDirect d
forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIFileStatus d -> ChatItem c d
updateFileStatus ChatItem c d
ChatItem 'CTDirect d
ci CIFileStatus d
CIFileStatus d
fileStatus
    (SChatType c, Maybe (d :~: d))
_ -> AChatItem -> ExceptT StoreError IO AChatItem
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AChatItem
aci