xftp: add URI encoding for FileDescription

src/Simplex/FileTransfer/Agent.hs

@@ -428,10 +428,10 @@ runXFTPSndWorker c srv Worker {doWork} = do
               size = FileSize $ sum $ map (fromIntegral . sndChunkSize) chunks
           -- snd description
           sndDescrChunks <- mapM toSndDescrChunk chunks
-          let fdSnd = FileDescription {party = SFSender, size, digest, key, nonce, chunkSize, chunks = sndDescrChunks}
+          let fdSnd = FileDescription {party = SFSender, size, digest, key, nonce, chunkSize, chunks = sndDescrChunks, redirect = False}
           validFdSnd <- either (throwError . INTERNAL) pure $ validateFileDescription fdSnd
           -- rcv descriptions
-          let fdRcv = FileDescription {party = SFRecipient, size, digest, key, nonce, chunkSize, chunks = []}
+          let fdRcv = FileDescription {party = SFRecipient, size, digest, key, nonce, chunkSize, chunks = [], redirect = False}
               fdRcvs = createRcvFileDescriptions fdRcv chunks
           validFdRcvs <- either (throwError . INTERNAL) pure $ mapM validateFileDescription fdRcvs
           pure (validFdSnd, validFdRcvs)

src/Simplex/FileTransfer/Client/Main.hs

@@ -297,8 +297,8 @@ cliSendFileOpts SendOptions {filePath, outputDir, numRecipients, xftpServers, re
       withExceptT (CLIError . show) $ encryptFile srcFile fileHdr key nonce fileSize' encSize encPath
       digest <- liftIO $ LC.sha512Hash <$> LB.readFile encPath
       let chunkSpecs = prepareChunkSpecs encPath chunkSizes
-          fdRcv = FileDescription {party = SFRecipient, size = FileSize encSize, digest = FileDigest digest, key, nonce, chunkSize = FileSize defChunkSize, chunks = []}
-          fdSnd = FileDescription {party = SFSender, size = FileSize encSize, digest = FileDigest digest, key, nonce, chunkSize = FileSize defChunkSize, chunks = []}
+          fdRcv = FileDescription {party = SFRecipient, size = FileSize encSize, digest = FileDigest digest, key, nonce, chunkSize = FileSize defChunkSize, chunks = [], redirect = False}
+          fdSnd = FileDescription {party = SFSender, size = FileSize encSize, digest = FileDigest digest, key, nonce, chunkSize = FileSize defChunkSize, chunks = [], redirect = False}
       logInfo $ "encrypted file to " <> tshow encPath
       pure (encPath, fdRcv, fdSnd, chunkSpecs, encSize)
     uploadFile :: TVar ChaChaDRG -> [XFTPChunkSpec] -> TVar [Int64] -> Int64 -> ExceptT CLIError IO [SentFileChunk]

src/Simplex/FileTransfer/Description.hs

@@ -30,6 +30,9 @@ module Simplex.FileTransfer.Description
     kb,
     mb,
     gb,
+    FileDescriptionURI (..),
+    encodeFileDescriptionURI,
+    decodeFileDescriptionURI,
   )
 where
 
@@ -50,10 +53,14 @@ import Data.Map (Map)
 import qualified Data.Map as M
 import Data.Maybe (fromMaybe)
 import Data.String
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Text.Encoding (decodeUtf8Lenient, encodeUtf8)
 import Data.Word (Word32)
 import qualified Data.Yaml as Y
 import Database.SQLite.Simple.FromField (FromField (..))
 import Database.SQLite.Simple.ToField (ToField (..))
+import Network.HTTP.Types (urlDecode, urlEncode)
 import Simplex.FileTransfer.Chunks
 import Simplex.FileTransfer.Protocol
 import qualified Simplex.Messaging.Crypto as C
@@ -69,7 +76,8 @@ data FileDescription (p :: FileParty) = FileDescription
     key :: C.SbKey,
     nonce :: C.CbNonce,
     chunkSize :: FileSize Word32,
-    chunks :: [FileChunk]
+    chunks :: [FileChunk],
+    redirect :: !Bool
   }
   deriving (Eq, Show)
 
@@ -147,7 +155,8 @@ data YAMLFileDescription = YAMLFileDescription
     key :: C.SbKey,
     nonce :: C.CbNonce,
     chunkSize :: String,
-    replicas :: [YAMLServerReplicas]
+    replicas :: [YAMLServerReplicas],
+    redirect :: !(Maybe Bool)
   }
   deriving (Eq, Show)
 
@@ -204,17 +213,36 @@ validateFileDescription fd@FileDescription {size, chunks}
     chunksSize = fromIntegral . foldl' (\s FileChunk {chunkSize} -> s + unFileSize chunkSize) 0
 
 encodeFileDescription :: FileDescription p -> YAMLFileDescription
-encodeFileDescription FileDescription {party, size, digest, key, nonce, chunkSize, chunks} =
+encodeFileDescription FileDescription {party, size, digest, key, nonce, chunkSize, chunks, redirect} =
   YAMLFileDescription
     { party = toFileParty party,
       size = B.unpack $ strEncode size,
       digest,
       key,
       nonce,
       chunkSize = B.unpack $ strEncode chunkSize,
-      replicas = encodeFileReplicas chunkSize chunks
+      replicas = encodeFileReplicas chunkSize chunks,
+      redirect = if redirect then Just True else Nothing
     }
 
+newtype FileDescriptionURI = FileDescriptionURI Text
+  deriving (Show)
+
+encodeFileDescriptionURI :: FileDescription 'FRecipient -> Either String FileDescriptionURI
+encodeFileDescriptionURI fd@FileDescription {chunks} =
+  case chunks of
+    [_] -> Right . FileDescriptionURI $ "https://simplex.chat/file/#?d=" <> decodeUtf8Lenient (urlEncode True yaml)
+    _ -> Left "must have exactly one chunk"
+  where
+    yaml = strEncode fd
+
+decodeFileDescriptionURI :: FileDescriptionURI -> Either String (FileDescription 'FRecipient)
+decodeFileDescriptionURI (FileDescriptionURI uri) =
+  case T.drop 4 <$> T.breakOn "#?d=" uri of
+    (_, "") -> Left "malformed URI"
+    ("https://simplex.chat/file/", params) -> strDecode . urlDecode True $ encodeUtf8 params
+    _ -> Left "not a file URI"
+
 instance (Integral a, Show a) => StrEncoding (FileSize a) where
   strEncode (FileSize b)
     | b' /= 0 = bshow b
@@ -285,13 +313,13 @@ unfoldChunksToReplicas defChunkSize = concatMap chunkReplicas
        in FileServerReplica {chunkNo, server, replicaId, replicaKey, digest = digest', chunkSize = chunkSize'}
 
 decodeFileDescription :: YAMLFileDescription -> Either String AFileDescription
-decodeFileDescription YAMLFileDescription {party, size, digest, key, nonce, chunkSize, replicas} = do
+decodeFileDescription YAMLFileDescription {party, size, digest, key, nonce, chunkSize, replicas, redirect} = do
   size' <- strDecode $ B.pack size
   chunkSize' <- strDecode $ B.pack chunkSize
   replicas' <- decodeFileParts replicas
   chunks <- foldReplicasToChunks chunkSize' replicas'
   pure $ case aFileParty party of
-    AFP party' -> AFD FileDescription {party = party', size = size', digest, key, nonce, chunkSize = chunkSize', chunks}
+    AFP party' -> AFD FileDescription {party = party', size = size', digest, key, nonce, chunkSize = chunkSize', chunks, redirect = fromMaybe False redirect}
   where
     decodeFileParts = fmap concat . mapM decodeYAMLServerReplicas
 

tests/AgentTests/SQLiteTests.hs

@@ -656,7 +656,8 @@ rcvFileDescr1 =
               chunkSize = defaultChunkSize,
               replicas = [FileChunkReplica {server = xftpServer1, replicaId, replicaKey = testFileReplicaKey}]
             }
-        ]
+        ],
+      redirect = False
     }
   where
     defaultChunkSize = FileSize $ mb 8

tests/FileDescriptionTests.hs

@@ -82,7 +82,8 @@ fileDesc =
                   FileChunkReplica {server = "xftp://abc=@example3.com", replicaId, replicaKey}
                 ]
             }
-        ]
+        ],
+      redirect = False
     }
   where
     defaultChunkSize = FileSize $ mb 8
@@ -128,7 +129,8 @@ yamlFileDesc =
                   "3:YWJj:MC4CAQAwBQYDK2VwBCIEIDfEfevydXXfKajz3sRkcQ7RPvfWUPoq6pu1TYHV1DEe"
                 ]
             }
-        ]
+        ],
+      redirect = Nothing
     }
 
 testParseYAMLFileDescription :: IO ()