update protocol/store to include file digest

src/Simplex/FileTransfer/Protocol.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
@@ -107,8 +108,7 @@ instance Protocol FileResponse where
     _ -> Nothing
 
 data FileCommand (p :: FileParty) where
-  -- Sender key, recipients keys, chunk size
-  FNEW :: SndPublicVerifyKey -> NonEmpty RcvPublicVerifyKey -> Word32 -> FileCommand Sender
+  FNEW :: FileInfo -> NonEmpty RcvPublicVerifyKey -> FileCommand Sender
   FADD :: NonEmpty RcvPublicVerifyKey -> FileCommand Sender
   FPUT :: FileCommand Sender
   FDEL :: FileCommand Sender
@@ -122,14 +122,21 @@ data FileCmd = forall p. FilePartyI p => FileCmd (SFileParty p) (FileCommand p)
 
 deriving instance Show FileCmd
 
+data FileInfo = FileInfo
+  { sndKey :: SndPublicVerifyKey,
+    size :: Word32,
+    digest :: ByteString
+  }
+  deriving (Eq, Show)
+
 instance FilePartyI p => ProtocolEncoding (FileCommand p) where
   type Tag (FileCommand p) = FileCommandTag p
   encodeProtocol _v = \case
-    FNEW sKey dhKeys chunkSize -> e (FNEW_, ' ', sKey, dhKeys, chunkSize)
-    FADD dhKeys -> e (FADD_, ' ', dhKeys)
+    FNEW file rKeys -> e (FNEW_, ' ', file, rKeys)
+    FADD rKeys -> e (FADD_, ' ', rKeys)
     FPUT -> e FPUT_
     FDEL -> e FDEL_
-    FGET dhKey -> e (FGET_, ' ', dhKey)
+    FGET rKey -> e (FGET_, ' ', rKey)
     FACK -> e FACK_
     PING -> e PING_
     where
@@ -155,7 +162,7 @@ instance ProtocolEncoding FileCmd where
   protocolP _v = \case
     FCT SSender tag ->
       FileCmd SSender <$> case tag of
-        FNEW_ -> FNEW <$> _smpP <*> smpP <*> smpP
+        FNEW_ -> FNEW <$> _smpP <*> smpP
         FADD_ -> FADD <$> _smpP
         FPUT_ -> pure FPUT
         FDEL_ -> pure FDEL
@@ -167,6 +174,10 @@ instance ProtocolEncoding FileCmd where
 
   checkCredentials t (FileCmd p c) = FileCmd p <$> checkCredentials t c
 
+instance Encoding FileInfo where
+  smpEncode FileInfo {sndKey, size, digest} = smpEncode (sndKey, size, digest)
+  smpP = FileInfo <$> smpP <*> smpP <*> smpP
+
 data FileResponseTag
   = FRChunkIds_
   | FRRcvIds_

src/Simplex/FileTransfer/Server/Store.hs

@@ -17,6 +17,7 @@ import Control.Concurrent.STM
 import Data.Functor (($>))
 import Data.Set (Set)
 import qualified Data.Set as S
+import Simplex.FileTransfer.Protocol (FileInfo)
 import Simplex.Messaging.Protocol hiding (SParty, SRecipient, SSender)
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
@@ -29,9 +30,9 @@ data FileStore = FileStore
 
 data FileRec = FileRec
   { senderId :: SenderId,
-    senderKey :: SndPublicVerifyKey,
-    recipientIds :: TVar (Set RecipientId),
-    filepath :: TVar (Maybe FilePath)
+    fileInfo :: FileInfo,
+    filePath :: TVar (Maybe FilePath),
+    recipientIds :: TVar (Set RecipientId)
   }
   deriving (Eq)
 
@@ -41,23 +42,23 @@ newQueueStore = do
   recipients <- TM.empty
   pure FileStore {files, recipients}
 
-addFile :: FileStore -> SenderId -> SndPublicVerifyKey -> STM (Either ErrorType ())
-addFile FileStore {files} sId sKey =
+addFile :: FileStore -> SenderId -> FileInfo -> STM (Either ErrorType ())
+addFile FileStore {files} sId fileInfo =
   ifM (TM.member sId files) (pure $ Left DUPLICATE_) $ do
-    f <- newFileRec sId sKey
+    f <- newFileRec sId fileInfo
     TM.insert sId f files
     pure $ Right ()
 
-newFileRec :: SenderId -> SndPublicVerifyKey -> STM FileRec
-newFileRec senderId senderKey = do
+newFileRec :: SenderId -> FileInfo -> STM FileRec
+newFileRec senderId fileInfo = do
   recipientIds <- newTVar S.empty
-  filepath <- newTVar Nothing
-  pure FileRec {senderId, senderKey, recipientIds, filepath}
+  filePath <- newTVar Nothing
+  pure FileRec {senderId, fileInfo, filePath, recipientIds}
 
 setFilePath :: FileStore -> SenderId -> FilePath -> STM (Either ErrorType ())
 setFilePath st sId fPath =
-  withFile st sId $ \FileRec {filepath} ->
-    writeTVar filepath (Just fPath) $> Right ()
+  withFile st sId $ \FileRec {filePath} ->
+    writeTVar filePath (Just fPath) $> Right ()
 
 addRecipient :: FileStore -> SenderId -> (RecipientId, RcvPublicVerifyKey) -> STM (Either ErrorType ())
 addRecipient st@FileStore {recipients} senderId recipient@(rId, _) =
@@ -82,8 +83,6 @@ deleteFile FileStore {files, recipients} senderId = do
 getFile :: FileStore -> SenderId -> STM (Either ErrorType FileRec)
 getFile st sId = withFile st sId $ pure . Right
 
--- TODO possibly, if acknowledgement of file reception by the last recipient
--- is going to lead to deleting the file this has to be updated and return some value to delete the actual file
 ackFile :: FileStore -> RecipientId -> STM (Either ErrorType ())
 ackFile st@FileStore {recipients} recipientId = do
   TM.lookupDelete recipientId recipients >>= \case