FileStore (#589)

* FileStore

* Set instead of List

* update

* refactor

* refactor

* sort imports

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>

src/Simplex/FileTransfer/Protocol.hs

@@ -13,11 +13,11 @@ module Simplex.FileTransfer.Protocol where
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Data (type (:~:) (Refl))
-import Data.Int (Int64)
 import Data.Kind (Type)
 import Data.List.NonEmpty (NonEmpty)
 import Data.Maybe (isJust, isNothing)
 import Data.Type.Equality (TestEquality (testEquality))
+import Data.Word (Word32)
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Notifications.Transport (ntfClientHandshake)
 import Simplex.Messaging.Protocol hiding (Cmd, Command (..), CommandTag (..), Recipient, SRecipient, SSender, Sender)
@@ -97,7 +97,7 @@ instance Protocol FileResponse where
 
 data FileCommand (p :: FileParty) where
   -- Sender key, recipients keys, chunk size
-  FNEW :: SndPublicVerifyKey -> NonEmpty RcvPublicVerifyKey -> Int64 -> FileCommand Sender
+  FNEW :: SndPublicVerifyKey -> NonEmpty RcvPublicVerifyKey -> Word32 -> FileCommand Sender
   FADD :: NonEmpty RcvPublicVerifyKey -> FileCommand Sender
   FPUT :: FileCommand Sender
   FDEL :: FileCommand Sender

src/Simplex/FileTransfer/Server/Store.hs

@@ -1 +1,100 @@
-module Simplex.FileTransfer.Server.Store where
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+
+module Simplex.FileTransfer.Server.Store
+  ( FileStore,
+    newQueueStore,
+    addFile,
+    setFilePath,
+    addRecipient,
+    deleteFile,
+    getFile,
+    ackFile,
+  )
+where
+
+import Control.Concurrent.STM
+import Data.Functor (($>))
+import Data.Set (Set)
+import qualified Data.Set as S
+import Simplex.Messaging.Protocol hiding (SParty, SRecipient, SSender)
+import Simplex.Messaging.TMap (TMap)
+import qualified Simplex.Messaging.TMap as TM
+import Simplex.Messaging.Util (ifM)
+
+data FileStore = FileStore
+  { files :: TMap SenderId FileRec,
+    recipients :: TMap RecipientId (SenderId, RcvPublicVerifyKey)
+  }
+
+data FileRec = FileRec
+  { senderId :: SenderId,
+    senderKey :: SndPublicVerifyKey,
+    recipientIds :: TVar (Set RecipientId),
+    filepath :: TVar (Maybe FilePath)
+  }
+  deriving (Eq)
+
+newQueueStore :: STM FileStore
+newQueueStore = do
+  files <- TM.empty
+  recipients <- TM.empty
+  pure FileStore {files, recipients}
+
+addFile :: FileStore -> SenderId -> SndPublicVerifyKey -> STM (Either ErrorType ())
+addFile FileStore {files} sId sKey =
+  ifM (TM.member sId files) (pure $ Left DUPLICATE_) $ do
+    f <- newFileRec sId sKey
+    TM.insert sId f files
+    pure $ Right ()
+
+newFileRec :: SenderId -> SndPublicVerifyKey -> STM FileRec
+newFileRec senderId senderKey = do
+  recipientIds <- newTVar S.empty
+  filepath <- newTVar Nothing
+  pure FileRec {senderId, senderKey, recipientIds, filepath}
+
+setFilePath :: FileStore -> SenderId -> FilePath -> STM (Either ErrorType ())
+setFilePath st sId fPath =
+  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, _) =
+  withFile st senderId $ \FileRec {recipientIds} -> do
+    rIds <- readTVar recipientIds
+    mem <- TM.member rId recipients
+    if rId `S.member` rIds || mem
+      then pure $ Left DUPLICATE_
+      else do
+        writeTVar recipientIds $! S.insert rId rIds
+        TM.insert rId recipient recipients
+        pure $ Right ()
+
+deleteFile :: FileStore -> SenderId -> STM (Either ErrorType ())
+deleteFile FileStore {files, recipients} senderId = do
+  TM.lookupDelete senderId files >>= \case
+    Just FileRec {recipientIds} -> do
+      readTVar recipientIds >>= mapM_ (`TM.delete` recipients)
+      pure $ Right ()
+    _ -> pure $ Left AUTH
+
+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
+    Just (sId, _) ->
+      withFile st sId $ \FileRec {recipientIds} -> do
+        modifyTVar' recipientIds $ S.delete recipientId
+        pure $ Right ()
+    _ -> pure $ Left AUTH
+
+withFile :: FileStore -> SenderId -> (FileRec -> STM (Either ErrorType a)) -> STM (Either ErrorType a)
+withFile FileStore {files} sId a =
+  TM.lookup sId files >>= \case
+    Just f -> a f
+    _ -> pure $ Left AUTH