fix relative paths, refactor

src/Simplex/Chat.hs

@@ -822,7 +822,7 @@ processChatCommand' vr = \case
           throwChatError (CECommandError $ "reaction already " <> if add then "added" else "removed")
         when (add && length rs >= maxMsgReactions) $
           throwChatError (CECommandError "too many reactions")
-  APIForwardChatItem (ChatRef fromCType fromChatId) (ChatRef toCType toChatId) itemId -> withUser $ \user -> withChatLock "forwardChatItem" $ case toCType of
+  APIForwardChatItem fromChatRef (ChatRef toCType toChatId) itemId -> withUser $ \user -> withChatLock "forwardChatItem" $ case toCType of
     CTDirect -> do
       cm <- prepareForward user
       sendContactContentMessage user toChatId False Nothing cm True
@@ -836,24 +836,11 @@ processChatCommand' vr = \case
     CTContactConnection -> pure $ chatCmdError (Just user) "not supported"
     where
       prepareForward :: User -> CM ComposedMessage
-      prepareForward user = case fromCType of
-        CTDirect -> do
-          (CChatItem _ ci) <- withStore $ \db -> getDirectChatItem db user fromChatId itemId
-          mc <- forwardMC ci
-          file <- forwardCryptoFile ci `catchChatError` \_ -> pure Nothing
-          pure $ ComposedMessage file Nothing mc
-        CTGroup -> do
-          (CChatItem _ ci) <- withStore $ \db -> getGroupChatItem db user fromChatId itemId
-          mc <- forwardMC ci
-          file <- forwardCryptoFile ci `catchChatError` \_ -> pure Nothing
-          pure $ ComposedMessage file Nothing mc
-        CTLocal -> do
-          (CChatItem _ ci) <- withStore $ \db -> getLocalChatItem db user fromChatId itemId
-          mc <- forwardMC ci
-          file <- forwardCryptoFile ci `catchChatError` \_ -> pure Nothing
-          pure $ ComposedMessage file Nothing mc
-        CTContactRequest -> throwChatError $ CECommandError "not supported"
-        CTContactConnection -> throwChatError $ CECommandError "not supported"
+      prepareForward user = do
+        (AChatItem _ _ _ ci) <- withStore $ \db -> getAChatItem db vr user fromChatRef itemId
+        mc <- forwardMC ci
+        file <- forwardCryptoFile ci `catchChatError` (\e -> toView (CRChatError (Just user) e) $> Nothing)
+        pure $ ComposedMessage file Nothing mc
         where
           forwardMC :: ChatItem c d -> CM MsgContent
           forwardMC ChatItem {meta = CIMeta {itemDeleted = Just _}} = throwChatError CEInvalidForward
@@ -866,20 +853,21 @@ processChatCommand' vr = \case
                 chatReadVar filesFolder >>= \case
                   Nothing ->
                     ifM (doesFileExist filePath) (pure $ Just fromCF) (pure Nothing)
-                  Just filesFolder ->
+                  Just filesFolder -> do
+                    let fsFromPath = filesFolder </> filePath
                     ifM
-                      (doesFileExist filePath)
+                      (doesFileExist fsFromPath)
                       ( do
-                          newPath <- liftIO $ filesFolder `uniqueCombine` fileName
-                          liftIO $ B.writeFile newPath "" -- create empty file
+                          fsNewPath <- liftIO $ filesFolder `uniqueCombine` fileName
+                          liftIO $ B.writeFile fsNewPath "" -- create empty file
                           encrypt <- chatReadVar encryptLocalFiles
                           cfArgs <- if encrypt then Just <$> (atomically . CF.randomArgs =<< asks random) else pure Nothing
-                          let toCF = CryptoFile newPath cfArgs
+                          let toCF = CryptoFile fsNewPath cfArgs
                           -- to keep forwarded file in case original is deleted
                           liftIOEither $ runExceptT $ withExceptT (ChatError . CEInternalError . show) $ do
-                            lb <- CF.readFile fromCF
+                            lb <- CF.readFile (fromCF {filePath = fsFromPath} :: CryptoFile)
                             CF.writeFile toCF lb
-                          pure $ Just toCF
+                          pure $ Just (toCF {filePath = takeFileName fsNewPath} :: CryptoFile)
                       )
                       (pure Nothing)
             | otherwise = pure Nothing

tests/ChatClient.hs

@@ -346,8 +346,8 @@ getTermLine cc =
   5000000 `timeout` atomically (readTQueue $ termQ cc) >>= \case
     Just s -> do
       -- remove condition to always echo virtual terminal
-      when True $ do
-      -- when (printOutput cc) $ do
+      -- when True $ do
+      when (printOutput cc) $ do
         name <- userName cc
         putStrLn $ name <> ": " <> s
       pure s

tests/ChatTests/Forward.hs

@@ -22,7 +22,7 @@ chatForwardTests = do
     it "from notes to notes" testForwardNotesToNotes -- TODO forward between different folders when supported
   describe "forward files" $ do
     it "from contact to contact" testForwardFileNoFilesFolder
-    fit "with relative paths: from contact to contact" testForwardFileRelativePaths
+    it "with relative paths: from contact to contact" testForwardFileRelativePaths
 
 testForwardContactToContact :: HasCallStack => FilePath -> IO ()
 testForwardContactToContact =
@@ -329,22 +329,22 @@ testForwardFileRelativePaths =
       bob `send` "> @alice -> @cath hi"
       bob <# "@cath -> forwarded"
       bob <## "      hi"
-      bob <# "/f @cath test.pdf"
+      bob <# "/f @cath test_1.pdf"
       bob <## "use /fc 2 to cancel sending"
       cath <# "bob> -> forwarded"
       cath <## "      hi"
-      cath <# "bob> sends file test.pdf (266.0 KiB / 272376 bytes)"
+      cath <# "bob> sends file test_1.pdf (266.0 KiB / 272376 bytes)"
       cath <## "use /fr 1 [<dir>/ | <path>] to receive it"
 
-      cath ##> "/fr 1 ./tests/tmp"
+      cath ##> "/fr 1"
       concurrentlyN_
-        [ bob <## "completed uploading file 2 (test.pdf) for cath",
+        [ bob <## "completed uploading file 2 (test_1.pdf) for cath",
           cath
-            <### [ "saving file 1 from bob to test.pdf",
-                   "started receiving file 1 (test.pdf) from bob"
+            <### [ "saving file 1 from bob to test_1.pdf",
+                   "started receiving file 1 (test_1.pdf) from bob"
                  ]
         ]
-      cath <## "completed receiving file 1 (test.pdf) from bob"
+      cath <## "completed receiving file 1 (test_1.pdf) from bob"
 
-      dest2 <- B.readFile "./tests/tmp/cath_files/test.pdf"
+      dest2 <- B.readFile "./tests/tmp/cath_files/test_1.pdf"
       dest2 `shouldBe` src