{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}

module Simplex.FileTransfer.Server.Store
  ( FileStore (..),
    FileRec (..),
    FileRecipient (..),
    RoundedFileTime,
    newFileStore,
    addFile,
    setFilePath,
    addRecipient,
    deleteFile,
    blockFile,
    deleteRecipient,
    expiredFilePath,
    getFile,
    ackFile,
    fileTimePrecision,
  )
where

import Control.Concurrent.STM
import Control.Monad
import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.Int (Int64)
import Data.Set (Set)
import qualified Data.Set as S
import Simplex.FileTransfer.Protocol (FileInfo (..), SFileParty (..), XFTPFileId)
import Simplex.FileTransfer.Transport (XFTPErrorType (..))
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Protocol (BlockingInfo, RcvPublicAuthKey, RecipientId, SenderId)
import Simplex.Messaging.Server.QueueStore (ServerEntityStatus (..))
import Simplex.Messaging.SystemTime
import Simplex.Messaging.TMap (TMap)
import qualified Simplex.Messaging.TMap as TM
import Simplex.Messaging.Util (ifM, ($>>=))

data FileStore = FileStore
  { FileStore -> TMap RecipientId FileRec
files :: TMap SenderId FileRec,
    FileStore -> TMap RecipientId (RecipientId, RcvPublicAuthKey)
recipients :: TMap RecipientId (SenderId, RcvPublicAuthKey),
    FileStore -> TVar Int64
usedStorage :: TVar Int64
  }

data FileRec = FileRec
  { FileRec -> RecipientId
senderId :: SenderId,
    FileRec -> FileInfo
fileInfo :: FileInfo,
    FileRec -> TVar (Maybe FilePath)
filePath :: TVar (Maybe FilePath),
    FileRec -> TVar (Set RecipientId)
recipientIds :: TVar (Set RecipientId),
    FileRec -> RoundedFileTime
createdAt :: RoundedFileTime,
    FileRec -> TVar ServerEntityStatus
fileStatus :: TVar ServerEntityStatus
  }

type RoundedFileTime = RoundedSystemTime 3600

fileTimePrecision :: Int64
fileTimePrecision :: Int64
fileTimePrecision = Int64
3600 -- truncate creation time to 1 hour

data FileRecipient = FileRecipient RecipientId RcvPublicAuthKey
  deriving (Int -> FileRecipient -> ShowS
[FileRecipient] -> ShowS
FileRecipient -> FilePath
(Int -> FileRecipient -> ShowS)
-> (FileRecipient -> FilePath)
-> ([FileRecipient] -> ShowS)
-> Show FileRecipient
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileRecipient -> ShowS
showsPrec :: Int -> FileRecipient -> ShowS
$cshow :: FileRecipient -> FilePath
show :: FileRecipient -> FilePath
$cshowList :: [FileRecipient] -> ShowS
showList :: [FileRecipient] -> ShowS
Show)

instance StrEncoding FileRecipient where
  strEncode :: FileRecipient -> ByteString
strEncode (FileRecipient RecipientId
rId RcvPublicAuthKey
rKey) = RecipientId -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode RecipientId
rId ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
":" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> RcvPublicAuthKey -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode RcvPublicAuthKey
rKey
  strP :: Parser FileRecipient
strP = RecipientId -> RcvPublicAuthKey -> FileRecipient
FileRecipient (RecipientId -> RcvPublicAuthKey -> FileRecipient)
-> Parser ByteString RecipientId
-> Parser ByteString (RcvPublicAuthKey -> FileRecipient)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString RecipientId
forall a. StrEncoding a => Parser a
strP Parser ByteString (RcvPublicAuthKey -> FileRecipient)
-> Parser ByteString Char
-> Parser ByteString (RcvPublicAuthKey -> FileRecipient)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
A.char Char
':' Parser ByteString (RcvPublicAuthKey -> FileRecipient)
-> Parser ByteString RcvPublicAuthKey -> Parser FileRecipient
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString RcvPublicAuthKey
forall a. StrEncoding a => Parser a
strP

newFileStore :: IO FileStore
newFileStore :: IO FileStore
newFileStore = do
  TMap RecipientId FileRec
files <- IO (TMap RecipientId FileRec)
forall k a. IO (TMap k a)
TM.emptyIO
  TMap RecipientId (RecipientId, RcvPublicAuthKey)
recipients <- IO (TMap RecipientId (RecipientId, RcvPublicAuthKey))
forall k a. IO (TMap k a)
TM.emptyIO
  TVar Int64
usedStorage <- Int64 -> IO (TVar Int64)
forall a. a -> IO (TVar a)
newTVarIO Int64
0
  FileStore -> IO FileStore
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileStore {TMap RecipientId FileRec
files :: TMap RecipientId FileRec
files :: TMap RecipientId FileRec
files, TMap RecipientId (RecipientId, RcvPublicAuthKey)
recipients :: TMap RecipientId (RecipientId, RcvPublicAuthKey)
recipients :: TMap RecipientId (RecipientId, RcvPublicAuthKey)
recipients, TVar Int64
usedStorage :: TVar Int64
usedStorage :: TVar Int64
usedStorage}

addFile :: FileStore -> SenderId -> FileInfo -> RoundedFileTime -> ServerEntityStatus -> STM (Either XFTPErrorType ())
addFile :: FileStore
-> RecipientId
-> FileInfo
-> RoundedFileTime
-> ServerEntityStatus
-> STM (Either XFTPErrorType ())
addFile FileStore {TMap RecipientId FileRec
files :: FileStore -> TMap RecipientId FileRec
files :: TMap RecipientId FileRec
files} RecipientId
sId FileInfo
fileInfo RoundedFileTime
createdAt ServerEntityStatus
status =
  STM Bool
-> STM (Either XFTPErrorType ())
-> STM (Either XFTPErrorType ())
-> STM (Either XFTPErrorType ())
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (RecipientId -> TMap RecipientId FileRec -> STM Bool
forall k a. Ord k => k -> TMap k a -> STM Bool
TM.member RecipientId
sId TMap RecipientId FileRec
files) (Either XFTPErrorType () -> STM (Either XFTPErrorType ())
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either XFTPErrorType () -> STM (Either XFTPErrorType ()))
-> Either XFTPErrorType () -> STM (Either XFTPErrorType ())
forall a b. (a -> b) -> a -> b
$ XFTPErrorType -> Either XFTPErrorType ()
forall a b. a -> Either a b
Left XFTPErrorType
DUPLICATE_) (STM (Either XFTPErrorType ()) -> STM (Either XFTPErrorType ()))
-> STM (Either XFTPErrorType ()) -> STM (Either XFTPErrorType ())
forall a b. (a -> b) -> a -> b
$ do
    FileRec
f <- RecipientId
-> FileInfo -> RoundedFileTime -> ServerEntityStatus -> STM FileRec
newFileRec RecipientId
sId FileInfo
fileInfo RoundedFileTime
createdAt ServerEntityStatus
status
    RecipientId -> FileRec -> TMap RecipientId FileRec -> STM ()
forall k a. Ord k => k -> a -> TMap k a -> STM ()
TM.insert RecipientId
sId FileRec
f TMap RecipientId FileRec
files
    Either XFTPErrorType () -> STM (Either XFTPErrorType ())
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either XFTPErrorType () -> STM (Either XFTPErrorType ()))
-> Either XFTPErrorType () -> STM (Either XFTPErrorType ())
forall a b. (a -> b) -> a -> b
$ () -> Either XFTPErrorType ()
forall a b. b -> Either a b
Right ()

newFileRec :: SenderId -> FileInfo -> RoundedFileTime -> ServerEntityStatus -> STM FileRec
newFileRec :: RecipientId
-> FileInfo -> RoundedFileTime -> ServerEntityStatus -> STM FileRec
newFileRec RecipientId
senderId FileInfo
fileInfo RoundedFileTime
createdAt ServerEntityStatus
status = do
  TVar (Set RecipientId)
recipientIds <- Set RecipientId -> STM (TVar (Set RecipientId))
forall a. a -> STM (TVar a)
newTVar Set RecipientId
forall a. Set a
S.empty
  TVar (Maybe FilePath)
filePath <- Maybe FilePath -> STM (TVar (Maybe FilePath))
forall a. a -> STM (TVar a)
newTVar Maybe FilePath
forall a. Maybe a
Nothing
  TVar ServerEntityStatus
fileStatus <- ServerEntityStatus -> STM (TVar ServerEntityStatus)
forall a. a -> STM (TVar a)
newTVar ServerEntityStatus
status
  FileRec -> STM FileRec
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileRec {RecipientId
senderId :: RecipientId
senderId :: RecipientId
senderId, FileInfo
fileInfo :: FileInfo
fileInfo :: FileInfo
fileInfo, TVar (Maybe FilePath)
filePath :: TVar (Maybe FilePath)
filePath :: TVar (Maybe FilePath)
filePath, TVar (Set RecipientId)
recipientIds :: TVar (Set RecipientId)
recipientIds :: TVar (Set RecipientId)
recipientIds, RoundedFileTime
createdAt :: RoundedFileTime
createdAt :: RoundedFileTime
createdAt, TVar ServerEntityStatus
fileStatus :: TVar ServerEntityStatus
fileStatus :: TVar ServerEntityStatus
fileStatus}

setFilePath :: FileStore -> SenderId -> FilePath -> STM (Either XFTPErrorType ())
setFilePath :: FileStore
-> RecipientId -> FilePath -> STM (Either XFTPErrorType ())
setFilePath FileStore
st RecipientId
sId FilePath
fPath =
  FileStore
-> RecipientId
-> (FileRec -> STM (Either XFTPErrorType ()))
-> STM (Either XFTPErrorType ())
forall a.
FileStore
-> RecipientId
-> (FileRec -> STM (Either XFTPErrorType a))
-> STM (Either XFTPErrorType a)
withFile FileStore
st RecipientId
sId ((FileRec -> STM (Either XFTPErrorType ()))
 -> STM (Either XFTPErrorType ()))
-> (FileRec -> STM (Either XFTPErrorType ()))
-> STM (Either XFTPErrorType ())
forall a b. (a -> b) -> a -> b
$ \FileRec {FileInfo
fileInfo :: FileRec -> FileInfo
fileInfo :: FileInfo
fileInfo, TVar (Maybe FilePath)
filePath :: FileRec -> TVar (Maybe FilePath)
filePath :: TVar (Maybe FilePath)
filePath} -> do
    TVar (Maybe FilePath) -> Maybe FilePath -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe FilePath)
filePath (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
fPath)
    TVar Int64 -> (Int64 -> Int64) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' (FileStore -> TVar Int64
usedStorage FileStore
st) (Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FileInfo -> Word32
size FileInfo
fileInfo))
    Either XFTPErrorType () -> STM (Either XFTPErrorType ())
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either XFTPErrorType () -> STM (Either XFTPErrorType ()))
-> Either XFTPErrorType () -> STM (Either XFTPErrorType ())
forall a b. (a -> b) -> a -> b
$ () -> Either XFTPErrorType ()
forall a b. b -> Either a b
Right ()

addRecipient :: FileStore -> SenderId -> FileRecipient -> STM (Either XFTPErrorType ())
addRecipient :: FileStore
-> RecipientId -> FileRecipient -> STM (Either XFTPErrorType ())
addRecipient st :: FileStore
st@FileStore {TMap RecipientId (RecipientId, RcvPublicAuthKey)
recipients :: FileStore -> TMap RecipientId (RecipientId, RcvPublicAuthKey)
recipients :: TMap RecipientId (RecipientId, RcvPublicAuthKey)
recipients} RecipientId
senderId (FileRecipient RecipientId
rId RcvPublicAuthKey
rKey) =
  FileStore
-> RecipientId
-> (FileRec -> STM (Either XFTPErrorType ()))
-> STM (Either XFTPErrorType ())
forall a.
FileStore
-> RecipientId
-> (FileRec -> STM (Either XFTPErrorType a))
-> STM (Either XFTPErrorType a)
withFile FileStore
st RecipientId
senderId ((FileRec -> STM (Either XFTPErrorType ()))
 -> STM (Either XFTPErrorType ()))
-> (FileRec -> STM (Either XFTPErrorType ()))
-> STM (Either XFTPErrorType ())
forall a b. (a -> b) -> a -> b
$ \FileRec {TVar (Set RecipientId)
recipientIds :: FileRec -> TVar (Set RecipientId)
recipientIds :: TVar (Set RecipientId)
recipientIds} -> do
    Set RecipientId
rIds <- TVar (Set RecipientId) -> STM (Set RecipientId)
forall a. TVar a -> STM a
readTVar TVar (Set RecipientId)
recipientIds
    Bool
mem <- RecipientId
-> TMap RecipientId (RecipientId, RcvPublicAuthKey) -> STM Bool
forall k a. Ord k => k -> TMap k a -> STM Bool
TM.member RecipientId
rId TMap RecipientId (RecipientId, RcvPublicAuthKey)
recipients
    if RecipientId
rId RecipientId -> Set RecipientId -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set RecipientId
rIds Bool -> Bool -> Bool
|| Bool
mem
      then Either XFTPErrorType () -> STM (Either XFTPErrorType ())
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either XFTPErrorType () -> STM (Either XFTPErrorType ()))
-> Either XFTPErrorType () -> STM (Either XFTPErrorType ())
forall a b. (a -> b) -> a -> b
$ XFTPErrorType -> Either XFTPErrorType ()
forall a b. a -> Either a b
Left XFTPErrorType
DUPLICATE_
      else do
        TVar (Set RecipientId) -> Set RecipientId -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Set RecipientId)
recipientIds (Set RecipientId -> STM ()) -> Set RecipientId -> STM ()
forall a b. (a -> b) -> a -> b
$! RecipientId -> Set RecipientId -> Set RecipientId
forall a. Ord a => a -> Set a -> Set a
S.insert RecipientId
rId Set RecipientId
rIds
        RecipientId
-> (RecipientId, RcvPublicAuthKey)
-> TMap RecipientId (RecipientId, RcvPublicAuthKey)
-> STM ()
forall k a. Ord k => k -> a -> TMap k a -> STM ()
TM.insert RecipientId
rId (RecipientId
senderId, RcvPublicAuthKey
rKey) TMap RecipientId (RecipientId, RcvPublicAuthKey)
recipients
        Either XFTPErrorType () -> STM (Either XFTPErrorType ())
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either XFTPErrorType () -> STM (Either XFTPErrorType ()))
-> Either XFTPErrorType () -> STM (Either XFTPErrorType ())
forall a b. (a -> b) -> a -> b
$ () -> Either XFTPErrorType ()
forall a b. b -> Either a b
Right ()

-- this function must be called after the file is deleted from the file system
deleteFile :: FileStore -> SenderId -> STM (Either XFTPErrorType ())
deleteFile :: FileStore -> RecipientId -> STM (Either XFTPErrorType ())
deleteFile FileStore {TMap RecipientId FileRec
files :: FileStore -> TMap RecipientId FileRec
files :: TMap RecipientId FileRec
files, TMap RecipientId (RecipientId, RcvPublicAuthKey)
recipients :: FileStore -> TMap RecipientId (RecipientId, RcvPublicAuthKey)
recipients :: TMap RecipientId (RecipientId, RcvPublicAuthKey)
recipients, TVar Int64
usedStorage :: FileStore -> TVar Int64
usedStorage :: TVar Int64
usedStorage} RecipientId
senderId = do
  RecipientId -> TMap RecipientId FileRec -> STM (Maybe FileRec)
forall k a. Ord k => k -> TMap k a -> STM (Maybe a)
TM.lookupDelete RecipientId
senderId TMap RecipientId FileRec
files STM (Maybe FileRec)
-> (Maybe FileRec -> STM (Either XFTPErrorType ()))
-> STM (Either XFTPErrorType ())
forall a b. STM a -> (a -> STM b) -> STM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just FileRec {FileInfo
fileInfo :: FileRec -> FileInfo
fileInfo :: FileInfo
fileInfo, TVar (Set RecipientId)
recipientIds :: FileRec -> TVar (Set RecipientId)
recipientIds :: TVar (Set RecipientId)
recipientIds} -> do
      TVar (Set RecipientId) -> STM (Set RecipientId)
forall a. TVar a -> STM a
readTVar TVar (Set RecipientId)
recipientIds STM (Set RecipientId) -> (Set RecipientId -> STM ()) -> STM ()
forall a b. STM a -> (a -> STM b) -> STM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (RecipientId -> STM ()) -> Set RecipientId -> STM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (RecipientId
-> TMap RecipientId (RecipientId, RcvPublicAuthKey) -> STM ()
forall k a. Ord k => k -> TMap k a -> STM ()
`TM.delete` TMap RecipientId (RecipientId, RcvPublicAuthKey)
recipients)
      TVar Int64 -> (Int64 -> Int64) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar Int64
usedStorage ((Int64 -> Int64) -> STM ()) -> (Int64 -> Int64) -> STM ()
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
subtract (Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int64) -> Word32 -> Int64
forall a b. (a -> b) -> a -> b
$ FileInfo -> Word32
size FileInfo
fileInfo)
      Either XFTPErrorType () -> STM (Either XFTPErrorType ())
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either XFTPErrorType () -> STM (Either XFTPErrorType ()))
-> Either XFTPErrorType () -> STM (Either XFTPErrorType ())
forall a b. (a -> b) -> a -> b
$ () -> Either XFTPErrorType ()
forall a b. b -> Either a b
Right ()
    Maybe FileRec
_ -> Either XFTPErrorType () -> STM (Either XFTPErrorType ())
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either XFTPErrorType () -> STM (Either XFTPErrorType ()))
-> Either XFTPErrorType () -> STM (Either XFTPErrorType ())
forall a b. (a -> b) -> a -> b
$ XFTPErrorType -> Either XFTPErrorType ()
forall a b. a -> Either a b
Left XFTPErrorType
AUTH

-- this function must be called after the file is deleted from the file system
blockFile :: FileStore -> SenderId -> BlockingInfo -> Bool -> STM (Either XFTPErrorType ())
blockFile :: FileStore
-> RecipientId
-> BlockingInfo
-> Bool
-> STM (Either XFTPErrorType ())
blockFile st :: FileStore
st@FileStore {TVar Int64
usedStorage :: FileStore -> TVar Int64
usedStorage :: TVar Int64
usedStorage} RecipientId
senderId BlockingInfo
info Bool
deleted =
  FileStore
-> RecipientId
-> (FileRec -> STM (Either XFTPErrorType ()))
-> STM (Either XFTPErrorType ())
forall a.
FileStore
-> RecipientId
-> (FileRec -> STM (Either XFTPErrorType a))
-> STM (Either XFTPErrorType a)
withFile FileStore
st RecipientId
senderId ((FileRec -> STM (Either XFTPErrorType ()))
 -> STM (Either XFTPErrorType ()))
-> (FileRec -> STM (Either XFTPErrorType ()))
-> STM (Either XFTPErrorType ())
forall a b. (a -> b) -> a -> b
$ \FileRec {FileInfo
fileInfo :: FileRec -> FileInfo
fileInfo :: FileInfo
fileInfo, TVar ServerEntityStatus
fileStatus :: FileRec -> TVar ServerEntityStatus
fileStatus :: TVar ServerEntityStatus
fileStatus} -> do
    Bool -> STM () -> STM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
deleted (STM () -> STM ()) -> STM () -> STM ()
forall a b. (a -> b) -> a -> b
$ TVar Int64 -> (Int64 -> Int64) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar Int64
usedStorage ((Int64 -> Int64) -> STM ()) -> (Int64 -> Int64) -> STM ()
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
subtract (Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int64) -> Word32 -> Int64
forall a b. (a -> b) -> a -> b
$ FileInfo -> Word32
size FileInfo
fileInfo)
    TVar ServerEntityStatus -> ServerEntityStatus -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar ServerEntityStatus
fileStatus (ServerEntityStatus -> STM ()) -> ServerEntityStatus -> STM ()
forall a b. (a -> b) -> a -> b
$! BlockingInfo -> ServerEntityStatus
EntityBlocked BlockingInfo
info
    Either XFTPErrorType () -> STM (Either XFTPErrorType ())
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either XFTPErrorType () -> STM (Either XFTPErrorType ()))
-> Either XFTPErrorType () -> STM (Either XFTPErrorType ())
forall a b. (a -> b) -> a -> b
$ () -> Either XFTPErrorType ()
forall a b. b -> Either a b
Right ()

deleteRecipient :: FileStore -> RecipientId -> FileRec -> STM ()
deleteRecipient :: FileStore -> RecipientId -> FileRec -> STM ()
deleteRecipient FileStore {TMap RecipientId (RecipientId, RcvPublicAuthKey)
recipients :: FileStore -> TMap RecipientId (RecipientId, RcvPublicAuthKey)
recipients :: TMap RecipientId (RecipientId, RcvPublicAuthKey)
recipients} RecipientId
rId FileRec {TVar (Set RecipientId)
recipientIds :: FileRec -> TVar (Set RecipientId)
recipientIds :: TVar (Set RecipientId)
recipientIds} = do
  RecipientId
-> TMap RecipientId (RecipientId, RcvPublicAuthKey) -> STM ()
forall k a. Ord k => k -> TMap k a -> STM ()
TM.delete RecipientId
rId TMap RecipientId (RecipientId, RcvPublicAuthKey)
recipients
  TVar (Set RecipientId)
-> (Set RecipientId -> Set RecipientId) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar (Set RecipientId)
recipientIds ((Set RecipientId -> Set RecipientId) -> STM ())
-> (Set RecipientId -> Set RecipientId) -> STM ()
forall a b. (a -> b) -> a -> b
$ RecipientId -> Set RecipientId -> Set RecipientId
forall a. Ord a => a -> Set a -> Set a
S.delete RecipientId
rId

getFile :: FileStore -> SFileParty p -> XFTPFileId -> STM (Either XFTPErrorType (FileRec, C.APublicAuthKey))
getFile :: forall (p :: FileParty).
FileStore
-> SFileParty p
-> RecipientId
-> STM (Either XFTPErrorType (FileRec, RcvPublicAuthKey))
getFile FileStore
st SFileParty p
party RecipientId
fId = case SFileParty p
party of
  SFileParty p
SFSender -> FileStore
-> RecipientId
-> (FileRec
    -> STM (Either XFTPErrorType (FileRec, RcvPublicAuthKey)))
-> STM (Either XFTPErrorType (FileRec, RcvPublicAuthKey))
forall a.
FileStore
-> RecipientId
-> (FileRec -> STM (Either XFTPErrorType a))
-> STM (Either XFTPErrorType a)
withFile FileStore
st RecipientId
fId ((FileRec
  -> STM (Either XFTPErrorType (FileRec, RcvPublicAuthKey)))
 -> STM (Either XFTPErrorType (FileRec, RcvPublicAuthKey)))
-> (FileRec
    -> STM (Either XFTPErrorType (FileRec, RcvPublicAuthKey)))
-> STM (Either XFTPErrorType (FileRec, RcvPublicAuthKey))
forall a b. (a -> b) -> a -> b
$ Either XFTPErrorType (FileRec, RcvPublicAuthKey)
-> STM (Either XFTPErrorType (FileRec, RcvPublicAuthKey))
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either XFTPErrorType (FileRec, RcvPublicAuthKey)
 -> STM (Either XFTPErrorType (FileRec, RcvPublicAuthKey)))
-> (FileRec -> Either XFTPErrorType (FileRec, RcvPublicAuthKey))
-> FileRec
-> STM (Either XFTPErrorType (FileRec, RcvPublicAuthKey))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FileRec, RcvPublicAuthKey)
-> Either XFTPErrorType (FileRec, RcvPublicAuthKey)
forall a b. b -> Either a b
Right ((FileRec, RcvPublicAuthKey)
 -> Either XFTPErrorType (FileRec, RcvPublicAuthKey))
-> (FileRec -> (FileRec, RcvPublicAuthKey))
-> FileRec
-> Either XFTPErrorType (FileRec, RcvPublicAuthKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\FileRec
f -> (FileRec
f, FileInfo -> RcvPublicAuthKey
sndKey (FileInfo -> RcvPublicAuthKey) -> FileInfo -> RcvPublicAuthKey
forall a b. (a -> b) -> a -> b
$ FileRec -> FileInfo
fileInfo FileRec
f))
  SFileParty p
SFRecipient ->
    RecipientId
-> TMap RecipientId (RecipientId, RcvPublicAuthKey)
-> STM (Maybe (RecipientId, RcvPublicAuthKey))
forall k a. Ord k => k -> TMap k a -> STM (Maybe a)
TM.lookup RecipientId
fId (FileStore -> TMap RecipientId (RecipientId, RcvPublicAuthKey)
recipients FileStore
st) STM (Maybe (RecipientId, RcvPublicAuthKey))
-> (Maybe (RecipientId, RcvPublicAuthKey)
    -> STM (Either XFTPErrorType (FileRec, RcvPublicAuthKey)))
-> STM (Either XFTPErrorType (FileRec, RcvPublicAuthKey))
forall a b. STM a -> (a -> STM b) -> STM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Just (RecipientId
sId, RcvPublicAuthKey
rKey) -> FileStore
-> RecipientId
-> (FileRec
    -> STM (Either XFTPErrorType (FileRec, RcvPublicAuthKey)))
-> STM (Either XFTPErrorType (FileRec, RcvPublicAuthKey))
forall a.
FileStore
-> RecipientId
-> (FileRec -> STM (Either XFTPErrorType a))
-> STM (Either XFTPErrorType a)
withFile FileStore
st RecipientId
sId ((FileRec
  -> STM (Either XFTPErrorType (FileRec, RcvPublicAuthKey)))
 -> STM (Either XFTPErrorType (FileRec, RcvPublicAuthKey)))
-> (FileRec
    -> STM (Either XFTPErrorType (FileRec, RcvPublicAuthKey)))
-> STM (Either XFTPErrorType (FileRec, RcvPublicAuthKey))
forall a b. (a -> b) -> a -> b
$ Either XFTPErrorType (FileRec, RcvPublicAuthKey)
-> STM (Either XFTPErrorType (FileRec, RcvPublicAuthKey))
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either XFTPErrorType (FileRec, RcvPublicAuthKey)
 -> STM (Either XFTPErrorType (FileRec, RcvPublicAuthKey)))
-> (FileRec -> Either XFTPErrorType (FileRec, RcvPublicAuthKey))
-> FileRec
-> STM (Either XFTPErrorType (FileRec, RcvPublicAuthKey))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FileRec, RcvPublicAuthKey)
-> Either XFTPErrorType (FileRec, RcvPublicAuthKey)
forall a b. b -> Either a b
Right ((FileRec, RcvPublicAuthKey)
 -> Either XFTPErrorType (FileRec, RcvPublicAuthKey))
-> (FileRec -> (FileRec, RcvPublicAuthKey))
-> FileRec
-> Either XFTPErrorType (FileRec, RcvPublicAuthKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,RcvPublicAuthKey
rKey)
      Maybe (RecipientId, RcvPublicAuthKey)
_ -> Either XFTPErrorType (FileRec, RcvPublicAuthKey)
-> STM (Either XFTPErrorType (FileRec, RcvPublicAuthKey))
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either XFTPErrorType (FileRec, RcvPublicAuthKey)
 -> STM (Either XFTPErrorType (FileRec, RcvPublicAuthKey)))
-> Either XFTPErrorType (FileRec, RcvPublicAuthKey)
-> STM (Either XFTPErrorType (FileRec, RcvPublicAuthKey))
forall a b. (a -> b) -> a -> b
$ XFTPErrorType -> Either XFTPErrorType (FileRec, RcvPublicAuthKey)
forall a b. a -> Either a b
Left XFTPErrorType
AUTH

expiredFilePath :: FileStore -> XFTPFileId -> Int64 -> STM (Maybe (Maybe FilePath))
expiredFilePath :: FileStore -> RecipientId -> Int64 -> STM (Maybe (Maybe FilePath))
expiredFilePath FileStore {TMap RecipientId FileRec
files :: FileStore -> TMap RecipientId FileRec
files :: TMap RecipientId FileRec
files} RecipientId
sId Int64
old =
  RecipientId -> TMap RecipientId FileRec -> STM (Maybe FileRec)
forall k a. Ord k => k -> TMap k a -> STM (Maybe a)
TM.lookup RecipientId
sId TMap RecipientId FileRec
files
    STM (Maybe FileRec)
-> (FileRec -> STM (Maybe (Maybe FilePath)))
-> STM (Maybe (Maybe FilePath))
forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, Monad f, Traversable f) =>
m (f a) -> (a -> m (f b)) -> m (f b)
$>>= \FileRec {TVar (Maybe FilePath)
filePath :: FileRec -> TVar (Maybe FilePath)
filePath :: TVar (Maybe FilePath)
filePath, createdAt :: FileRec -> RoundedFileTime
createdAt = RoundedSystemTime Int64
createdAt} ->
      if Int64
createdAt Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
fileTimePrecision Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
old
        then Maybe FilePath -> Maybe (Maybe FilePath)
forall a. a -> Maybe a
Just (Maybe FilePath -> Maybe (Maybe FilePath))
-> STM (Maybe FilePath) -> STM (Maybe (Maybe FilePath))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar (Maybe FilePath) -> STM (Maybe FilePath)
forall a. TVar a -> STM a
readTVar TVar (Maybe FilePath)
filePath
        else Maybe (Maybe FilePath) -> STM (Maybe (Maybe FilePath))
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Maybe FilePath)
forall a. Maybe a
Nothing

ackFile :: FileStore -> RecipientId -> STM (Either XFTPErrorType ())
ackFile :: FileStore -> RecipientId -> STM (Either XFTPErrorType ())
ackFile st :: FileStore
st@FileStore {TMap RecipientId (RecipientId, RcvPublicAuthKey)
recipients :: FileStore -> TMap RecipientId (RecipientId, RcvPublicAuthKey)
recipients :: TMap RecipientId (RecipientId, RcvPublicAuthKey)
recipients} RecipientId
recipientId = do
  RecipientId
-> TMap RecipientId (RecipientId, RcvPublicAuthKey)
-> STM (Maybe (RecipientId, RcvPublicAuthKey))
forall k a. Ord k => k -> TMap k a -> STM (Maybe a)
TM.lookupDelete RecipientId
recipientId TMap RecipientId (RecipientId, RcvPublicAuthKey)
recipients STM (Maybe (RecipientId, RcvPublicAuthKey))
-> (Maybe (RecipientId, RcvPublicAuthKey)
    -> STM (Either XFTPErrorType ()))
-> STM (Either XFTPErrorType ())
forall a b. STM a -> (a -> STM b) -> STM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just (RecipientId
sId, RcvPublicAuthKey
_) ->
      FileStore
-> RecipientId
-> (FileRec -> STM (Either XFTPErrorType ()))
-> STM (Either XFTPErrorType ())
forall a.
FileStore
-> RecipientId
-> (FileRec -> STM (Either XFTPErrorType a))
-> STM (Either XFTPErrorType a)
withFile FileStore
st RecipientId
sId ((FileRec -> STM (Either XFTPErrorType ()))
 -> STM (Either XFTPErrorType ()))
-> (FileRec -> STM (Either XFTPErrorType ()))
-> STM (Either XFTPErrorType ())
forall a b. (a -> b) -> a -> b
$ \FileRec {TVar (Set RecipientId)
recipientIds :: FileRec -> TVar (Set RecipientId)
recipientIds :: TVar (Set RecipientId)
recipientIds} -> do
        TVar (Set RecipientId)
-> (Set RecipientId -> Set RecipientId) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar (Set RecipientId)
recipientIds ((Set RecipientId -> Set RecipientId) -> STM ())
-> (Set RecipientId -> Set RecipientId) -> STM ()
forall a b. (a -> b) -> a -> b
$ RecipientId -> Set RecipientId -> Set RecipientId
forall a. Ord a => a -> Set a -> Set a
S.delete RecipientId
recipientId
        Either XFTPErrorType () -> STM (Either XFTPErrorType ())
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either XFTPErrorType () -> STM (Either XFTPErrorType ()))
-> Either XFTPErrorType () -> STM (Either XFTPErrorType ())
forall a b. (a -> b) -> a -> b
$ () -> Either XFTPErrorType ()
forall a b. b -> Either a b
Right ()
    Maybe (RecipientId, RcvPublicAuthKey)
_ -> Either XFTPErrorType () -> STM (Either XFTPErrorType ())
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either XFTPErrorType () -> STM (Either XFTPErrorType ()))
-> Either XFTPErrorType () -> STM (Either XFTPErrorType ())
forall a b. (a -> b) -> a -> b
$ XFTPErrorType -> Either XFTPErrorType ()
forall a b. a -> Either a b
Left XFTPErrorType
AUTH

withFile :: FileStore -> SenderId -> (FileRec -> STM (Either XFTPErrorType a)) -> STM (Either XFTPErrorType a)
withFile :: forall a.
FileStore
-> RecipientId
-> (FileRec -> STM (Either XFTPErrorType a))
-> STM (Either XFTPErrorType a)
withFile FileStore {TMap RecipientId FileRec
files :: FileStore -> TMap RecipientId FileRec
files :: TMap RecipientId FileRec
files} RecipientId
sId FileRec -> STM (Either XFTPErrorType a)
a =
  RecipientId -> TMap RecipientId FileRec -> STM (Maybe FileRec)
forall k a. Ord k => k -> TMap k a -> STM (Maybe a)
TM.lookup RecipientId
sId TMap RecipientId FileRec
files STM (Maybe FileRec)
-> (Maybe FileRec -> STM (Either XFTPErrorType a))
-> STM (Either XFTPErrorType a)
forall a b. STM a -> (a -> STM b) -> STM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just FileRec
f -> FileRec -> STM (Either XFTPErrorType a)
a FileRec
f
    Maybe FileRec
_ -> Either XFTPErrorType a -> STM (Either XFTPErrorType a)
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either XFTPErrorType a -> STM (Either XFTPErrorType a))
-> Either XFTPErrorType a -> STM (Either XFTPErrorType a)
forall a b. (a -> b) -> a -> b
$ XFTPErrorType -> Either XFTPErrorType a
forall a b. a -> Either a b
Left XFTPErrorType
AUTH