simplexmq/tests/FileDescriptionTests.hs

{-# 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)