xftp: prohibit YAML aliases, limit file description replicas (#1965)

* xftp: limit description replicas, no YAML aliases

* inline limits

* xftp: derive file description chunk limit from maximum file size

* xftp: allow descriptions of 64 GB files at redundancy 4

src/Simplex/FileTransfer/Description.hs

@@ -217,17 +217,22 @@ instance FilePartyI p => StrEncoding (FileDescription p) where
 
 instance StrEncoding AFileDescription where
   strEncode (AFD fd) = strEncode fd
-  strDecode = decodeFileDescription <=< first show . Y.decodeEither'
+  strDecode s
+    | B.elem '*' s = Left "YAML aliases are not allowed"
+    | otherwise = decodeFileDescription =<< first show (Y.decodeEither' s)
   strP = strDecode <$?> A.takeByteString
 
 validateFileDescription :: FileDescription p -> Either String (ValidFileDescription p)
 validateFileDescription fd@FileDescription {size, chunks}
   | chunkNos /= [1 .. length chunks] = Left "chunk numbers are not sequential"
   | chunksSize chunks /= unFileSize size = Left "chunks total size is different than file size"
+  | any (> 16) replicaCounts = Left "too many chunk replicas"
+  | sum replicaCounts > 131072 = Left "too many file replicas"
   | otherwise = Right $ ValidFD fd
   where
     chunkNos = map (\FileChunk {chunkNo} -> chunkNo) chunks
     chunksSize = foldl' (\(s :: Int64) FileChunk {chunkSize} -> s + fromIntegral (unFileSize chunkSize)) 0
+    replicaCounts = map (\FileChunk {replicas} -> length replicas) chunks
 
 sharedDescriptionHash :: FileDescription p -> ByteString
 sharedDescriptionHash FileDescription {size, digest, key, nonce, chunkSize, chunks} =

tests/FileDescriptionTests.hs

@@ -8,7 +8,10 @@ module FileDescriptionTests where
 
 import Control.Exception (bracket_)
 import qualified Data.ByteString.Char8 as B
+import Data.Either (isRight)
 import qualified Data.Yaml as Y
+import Simplex.FileTransfer.Chunks (chunkSize3)
+import Simplex.FileTransfer.Client (prepareChunkSizes)
 import Simplex.FileTransfer.Description
 import Simplex.FileTransfer.Protocol
 import qualified Simplex.Messaging.Crypto as C
@@ -25,6 +28,8 @@ fileDescriptionTests = do
     it "parse YAML file description" testParseYAMLFileDescription
     it "serialize YAML file description" testSerializeYAMLFileDescription
     it "parse file description" testParseFileDescription
+    it "reject file description with YAML aliases" testRejectYAMLAliases
+    it "limit replicas per chunk and per file" testFileDescriptionLimits
     it "serialize file description" testSerializeFileDescription
     describe "file description URIs" $ do
       it "round trip file description URI" testFileDescriptionURI
@@ -158,6 +163,41 @@ testParseFileDescription = do
     Left e -> expectationFailure $ show e
     Right fd -> fd `shouldBe` fileDesc
 
+testRejectYAMLAliases :: IO ()
+testRejectYAMLAliases = do
+  (yaml, sizeLine) <- B.breakSubstring "size: " <$> B.readFile fileDescPath
+  let (header, groups) = B.breakSubstring "- chunks:" yaml
+      aliased = header <> "- &g\n  " <> B.drop 2 groups <> "- *g\n" <> sizeLine
+  (strDecode aliased :: Either String (FileDescription 'FRecipient)) `shouldBe` Left "YAML aliases are not allowed"
+
+testFileDescriptionLimits :: IO ()
+testFileDescriptionLimits = do
+  let largestSplit = prepareChunkSizes (maxFileSizeHard - mb 1)
+      split64GB = prepareChunkSizes (gb 64 - mb 1)
+  length largestSplit `shouldBe` 1282
+  length split64GB `shouldBe` 16386
+  validateFileDescription (descriptionOf largestSplit 16) `shouldSatisfy` isRight
+  validateFileDescription (descriptionOf largestSplit 17) `shouldBe` Left "too many chunk replicas"
+  validateFileDescription (descriptionOf split64GB 4) `shouldSatisfy` isRight
+  validateFileDescription (descriptionOf (replicate 8192 chunkSize3) 16) `shouldSatisfy` isRight
+  validateFileDescription (descriptionOf (replicate 8193 chunkSize3) 16) `shouldBe` Left "too many file replicas"
+  where
+    FileDescription {chunks = fixtureChunks} = fileDesc
+    fixtureReplicas = concatMap (\FileChunk {replicas} -> replicas) fixtureChunks
+    descriptionOf sizes n =
+      FileDescription
+        { party = SFRecipient,
+          size = FileSize $ sum $ map fromIntegral sizes,
+          digest = FileDigest "abc",
+          key = testSbKey,
+          nonce = testCbNonce,
+          chunkSize = FileSize chunkSize3,
+          chunks = zipWith chunk [1 ..] sizes,
+          redirect = Nothing
+        }
+      where
+        chunk chunkNo sz = FileChunk {chunkNo, chunkSize = FileSize sz, digest = FileDigest "ghi", replicas = take n $ cycle fixtureReplicas}
+
 testSerializeFileDescription :: HasTestEnv => IO ()
 testSerializeFileDescription = withRemoveTmpFile $ do
   B.writeFile tmpFileDescPath $ strEncode fileDesc