{-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module FileDescriptionTests where import Control.Exception (bracket_) import qualified Data.ByteString.Char8 as B import qualified Data.Yaml as Y import Simplex.FileTransfer.Description import Simplex.FileTransfer.Protocol import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Encoding.String (StrEncoding (..)) import Simplex.Messaging.Protocol (EntityId (..)) import Simplex.Messaging.ServiceScheme (ServiceScheme (..)) import System.Directory (removeFile) import Test.Hspec hiding (fit, it) import Util fileDescriptionTests :: Spec fileDescriptionTests = do describe "file description parsing / serializing" $ 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 "reject file description with too many replicas" testRejectTooManyReplicas it "serialize file description" testSerializeFileDescription describe "file description URIs" $ do it "round trip file description URI" testFileDescriptionURI it "round trip file description URI with extra JSON" testFileDescriptionURIExtras fileDescPath :: FilePath fileDescPath = "tests/fixtures/file_description.yaml" tmpFileDescPath :: HasTestEnv => FilePath tmpFileDescPath = testPath "file_description.yaml" testSbKey :: C.SbKey testSbKey = either error id $ strDecode "00n8p1tJq5E-SGnHcYTOrS4A9I07gTA_WFD6MTFFFOY=" testCbNonce :: C.CbNonce testCbNonce = either error id $ strDecode "dPSF-wrQpDiK_K6sYv0BDBZ9S4dg-jmu" fileDesc :: FileDescription 'FRecipient fileDesc = FileDescription { party = SFRecipient, size = FileSize $ mb 26, digest = FileDigest "abc", key = testSbKey, nonce = testCbNonce, chunkSize = defaultChunkSize, chunks = [ FileChunk { chunkNo = 1, digest = chunkDigest, chunkSize = defaultChunkSize, replicas = [ FileChunkReplica {server = "xftp://abc=@example1.com", replicaId, replicaKey}, FileChunkReplica {server = "xftp://abc=@example3.com", replicaId, replicaKey} ] }, FileChunk { chunkNo = 2, digest = chunkDigest, chunkSize = defaultChunkSize, replicas = [ FileChunkReplica {server = "xftp://abc=@example2.com", replicaId, replicaKey}, FileChunkReplica {server = "xftp://abc=@example4.com", replicaId, replicaKey} ] }, FileChunk { chunkNo = 3, digest = chunkDigest, chunkSize = defaultChunkSize, replicas = [ FileChunkReplica {server = "xftp://abc=@example1.com", replicaId, replicaKey}, FileChunkReplica {server = "xftp://abc=@example4.com", replicaId, replicaKey} ] }, FileChunk { chunkNo = 4, digest = chunkDigest, chunkSize = FileSize $ mb 2, replicas = [ FileChunkReplica {server = "xftp://abc=@example2.com", replicaId, replicaKey}, FileChunkReplica {server = "xftp://abc=@example3.com", replicaId, replicaKey} ] } ], redirect = Nothing } where defaultChunkSize = FileSize $ mb 8 replicaId = ChunkReplicaId $ EntityId "abc" replicaKey = C.APrivateAuthKey C.SEd25519 "MC4CAQAwBQYDK2VwBCIEIDfEfevydXXfKajz3sRkcQ7RPvfWUPoq6pu1TYHV1DEe" chunkDigest = FileDigest "ghi" yamlFileDesc :: YAMLFileDescription yamlFileDesc = YAMLFileDescription { party = FRecipient, size = "26mb", chunkSize = "8mb", digest = FileDigest "abc", key = testSbKey, nonce = testCbNonce, replicas = [ YAMLServerReplicas { server = "xftp://abc=@example1.com", chunks = [ "1:YWJj:MC4CAQAwBQYDK2VwBCIEIDfEfevydXXfKajz3sRkcQ7RPvfWUPoq6pu1TYHV1DEe:Z2hp", "3:YWJj:MC4CAQAwBQYDK2VwBCIEIDfEfevydXXfKajz3sRkcQ7RPvfWUPoq6pu1TYHV1DEe:Z2hp" ] }, YAMLServerReplicas { server = "xftp://abc=@example2.com", chunks = [ "2:YWJj:MC4CAQAwBQYDK2VwBCIEIDfEfevydXXfKajz3sRkcQ7RPvfWUPoq6pu1TYHV1DEe:Z2hp", "4:YWJj:MC4CAQAwBQYDK2VwBCIEIDfEfevydXXfKajz3sRkcQ7RPvfWUPoq6pu1TYHV1DEe:Z2hp:2mb" ] }, YAMLServerReplicas { server = "xftp://abc=@example3.com", chunks = [ "1:YWJj:MC4CAQAwBQYDK2VwBCIEIDfEfevydXXfKajz3sRkcQ7RPvfWUPoq6pu1TYHV1DEe", "4:YWJj:MC4CAQAwBQYDK2VwBCIEIDfEfevydXXfKajz3sRkcQ7RPvfWUPoq6pu1TYHV1DEe" ] }, YAMLServerReplicas { server = "xftp://abc=@example4.com", chunks = [ "2:YWJj:MC4CAQAwBQYDK2VwBCIEIDfEfevydXXfKajz3sRkcQ7RPvfWUPoq6pu1TYHV1DEe", "3:YWJj:MC4CAQAwBQYDK2VwBCIEIDfEfevydXXfKajz3sRkcQ7RPvfWUPoq6pu1TYHV1DEe" ] } ], redirect = Nothing } testParseYAMLFileDescription :: IO () testParseYAMLFileDescription = do yfd <- Y.decodeFileThrow fileDescPath yfd `shouldBe` yamlFileDesc testSerializeYAMLFileDescription :: HasTestEnv => IO () testSerializeYAMLFileDescription = withRemoveTmpFile $ do Y.encodeFile tmpFileDescPath yamlFileDesc fdSer <- B.readFile tmpFileDescPath fdExp <- B.readFile fileDescPath fdSer `shouldBe` fdExp testParseFileDescription :: IO () testParseFileDescription = do r <- strDecode <$> B.readFile fileDescPath case r of 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" testRejectTooManyReplicas :: IO () testRejectTooManyReplicas = do let FileDescription {chunks} = fileDesc repeatReplicas c@FileChunk {replicas} = (c :: FileChunk) {replicas = concat $ replicate 9 replicas} validateFileDescription ((fileDesc :: FileDescription 'FRecipient) {chunks = map repeatReplicas chunks}) `shouldBe` Left "too many chunk replicas" testSerializeFileDescription :: HasTestEnv => IO () testSerializeFileDescription = withRemoveTmpFile $ do B.writeFile tmpFileDescPath $ strEncode fileDesc fdSer <- B.readFile tmpFileDescPath fdExp <- B.readFile fileDescPath fdSer `shouldBe` fdExp testFileDescriptionURI :: IO () testFileDescriptionURI = do vfd <- either fail pure $ validateFileDescription fileDesc let descr = FileDescriptionURI SSSimplex vfd mempty strDecode (strEncode descr) `shouldBe` Right descr testFileDescriptionURIExtras :: IO () testFileDescriptionURIExtras = do vfd <- either fail pure $ validateFileDescription fileDesc let descr = FileDescriptionURI SSSimplex vfd $ Just "{\"something\":\"extra\",\"more\":true}" strDecode (strEncode descr) `shouldBe` Right descr withRemoveTmpFile :: HasTestEnv => IO () -> IO () withRemoveTmpFile = bracket_ (pure ()) (removeFile tmpFileDescPath)