support redirect file descriptions in xftp CLI receive

src/Simplex/FileTransfer/Client/Main.hs

@@ -406,9 +406,13 @@ cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath,
           when (B.null fragment) $ throwE $ CLIError "Invalid URL: no fragment"
           vfd@(ValidFileDescription FileDescription {redirect = r}) <- either (throwE . CLIError . ("Invalid web link: " <>)) pure $ decodeWebURI fragment
           case r of
-            Just _ -> throwE $ CLIError "Redirect descriptions are not yet supported via CLI. Download in browser instead."
+            Just ri -> resolveRedirect vfd ri
+            Nothing -> pure vfd
+      | otherwise = do
+          vfd@(ValidFileDescription FileDescription {redirect = r}) <- getFileDescription' fileDescription
+          case r of
+            Just ri -> resolveRedirect vfd ri
             Nothing -> pure vfd
-      | otherwise = getFileDescription' fileDescription
     receive :: ValidFileDescription 'FRecipient -> ExceptT CLIError IO ()
     receive (ValidFileDescription FileDescription {size, digest, key, nonce, chunks}) = do
       encPath <- getEncPath tempPath "xftp"
@@ -434,7 +438,8 @@ cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath,
       whenM (doesPathExist encPath) $ removeDirectoryRecursive encPath
       liftIO $ do
         printNoNewLine $ "File downloaded: " <> path
-        removeFD yes fileDescription
+        unless ("http://" `isPrefixOf` fileDescription || "https://" `isPrefixOf` fileDescription) $
+          removeFD yes fileDescription
     downloadFileChunk :: TVar ChaChaDRG -> XFTPClientAgent -> FilePath -> FileSize Int64 -> TVar [Int64] -> FileChunk -> ExceptT CLIError IO (Int, FilePath)
     downloadFileChunk g a encPath (FileSize encSize) downloadedChunks FileChunk {chunkNo, chunkSize, digest, replicas = replica : _} = do
       let FileChunkReplica {server, replicaId, replicaKey} = replica
@@ -464,6 +469,34 @@ cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath,
       c <- withRetry retryCount $ getXFTPServerClient a server
       withRetry retryCount $ ackXFTPChunk c replicaKey (unChunkReplicaId replicaId)
     acknowledgeFileChunk _ _ = throwE $ CLIError "chunk has no replicas"
+    resolveRedirect :: ValidFileDescription 'FRecipient -> RedirectFileInfo -> ExceptT CLIError IO (ValidFileDescription 'FRecipient)
+    resolveRedirect (ValidFileDescription FileDescription {size, digest, key, nonce, chunks}) RedirectFileInfo {size = rdSize, digest = rdDigest} = do
+      encPath <- getEncPath tempPath "xftp-redirect"
+      createDirectory encPath
+      a <- liftIO $ newXFTPAgent defaultXFTPClientAgentConfig
+      liftIO $ printNoNewLine "Resolving redirect..."
+      downloadedChunks <- newTVarIO []
+      let srv FileChunk {replicas} = case replicas of
+            [] -> error "empty FileChunk.replicas"
+            FileChunkReplica {server} : _ -> server
+          srvChunks = groupAllOn srv chunks
+      g <- liftIO C.newRandom
+      (errs, rs) <- partitionEithers . concat <$> liftIO (pooledForConcurrentlyN 16 srvChunks $ mapM $ runExceptT . downloadFileChunk g a encPath size downloadedChunks)
+      mapM_ throwE errs
+      let chunkPaths = map snd $ sortOn fst rs
+      encDigest <- liftIO $ LC.sha512Hash <$> readChunks chunkPaths
+      when (encDigest /= unFileDigest digest) $ throwE $ CLIError "Redirect: file digest mismatch"
+      encSize <- liftIO $ foldM (\s path -> (s +) . fromIntegral <$> getFileSize path) 0 chunkPaths
+      when (FileSize encSize /= size) $ throwE $ CLIError "Redirect: file size mismatch"
+      CryptoFile tmpFile _ <- withExceptT cliCryptoError $ decryptChunks encSize chunkPaths key nonce $ \_ ->
+        fmap CF.plain $ uniqueCombine encPath "redirect.yaml"
+      yaml <- liftIO $ B.readFile tmpFile
+      whenM (doesPathExist encPath) $ removeDirectoryRecursive encPath
+      innerVfd@(ValidFileDescription FileDescription {size = innerSize, digest = innerDigest}) <-
+        either (throwE . CLIError . ("Redirect: invalid inner file description: " <>)) pure $ strDecode yaml
+      when (innerSize /= rdSize) $ throwE $ CLIError "Redirect: inner file size mismatch"
+      when (innerDigest /= rdDigest) $ throwE $ CLIError "Redirect: inner file digest mismatch"
+      pure innerVfd
 
 printProgress :: String -> Int64 -> Int64 -> IO ()
 printProgress s part total = printNoNewLine $ s <> " " <> show ((part * 100) `div` total) <> "%"