add key to XFTP server control port command (#1070)

* add key to XFTP server control port command

* name

src/Simplex/FileTransfer/Server.hs

@@ -26,7 +26,7 @@ import Data.List (intercalate)
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as L
 import qualified Data.Map.Strict as M
-import Data.Maybe (fromMaybe, isJust)
+import Data.Maybe (fromMaybe)
 import qualified Data.Text as T
 import Data.Time.Clock (UTCTime (..), diffTimeToPicoseconds, getCurrentTime)
 import Data.Time.Clock.System (SystemTime (..), getSystemTime)
@@ -207,13 +207,15 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
                 Left err -> hPutStrLn h ("error: " <> err) >> cpLoop h
             processCP h = \case
               CPStatsRTS -> E.tryAny getRTSStats >>= either (hPrint h) (hPrint h)
-              CPDelete fileId -> unliftIO u $ do
+              CPDelete fileId fKey -> unliftIO u $ do
                 fs <- asks store
                 r <- runExceptT $ do
                   let asSender = ExceptT . atomically $ getFile fs SFSender fileId
                   let asRecipient = ExceptT . atomically $ getFile fs SFRecipient fileId
-                  (fr, _) <- asSender `catchError` const asRecipient
-                  ExceptT $ deleteServerFile_ fr
+                  (fr, fKey') <- asSender `catchError` const asRecipient
+                  if fKey == fKey'
+                    then ExceptT $ deleteServerFile_ fr
+                    else throwError AUTH
                 liftIO . hPutStrLn h $ either (\e -> "error: " <> show e) (\() -> "ok") r
               CPHelp -> hPutStrLn h "commands: stats-rts, delete, help, quit"
               CPQuit -> pure ()

src/Simplex/FileTransfer/Server/Control.hs

@@ -5,11 +5,12 @@ module Simplex.FileTransfer.Server.Control where
 
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.ByteString (ByteString)
+import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
 
 data ControlProtocol
   = CPStatsRTS
-  | CPDelete ByteString
+  | CPDelete ByteString C.APublicAuthKey
   | CPHelp
   | CPQuit
   | CPSkip
@@ -17,14 +18,14 @@ data ControlProtocol
 instance StrEncoding ControlProtocol where
   strEncode = \case
     CPStatsRTS -> "stats-rts"
-    CPDelete bs -> "delete " <> strEncode bs
+    CPDelete fId fKey -> strEncode (Str "delete", fId, fKey)
     CPHelp -> "help"
     CPQuit -> "quit"
     CPSkip -> ""
   strP =
     A.takeTill (== ' ') >>= \case
       "stats-rts" -> pure CPStatsRTS
-      "delete" -> CPDelete <$> (A.space *> strP)
+      "delete" -> CPDelete <$> _strP <*> _strP
       "help" -> pure CPHelp
       "quit" -> pure CPQuit
       "" -> pure CPSkip

src/Simplex/FileTransfer/Server/Store.hs

@@ -22,7 +22,6 @@ where
 
 import Control.Concurrent.STM
 import qualified Data.Attoparsec.ByteString.Char8 as A
-import Data.Functor (($>))
 import Data.Int (Int64)
 import Data.Set (Set)
 import qualified Data.Set as S