module Sync.MerkleTree.Test where import Control.Concurrent import Control.Monad import Data.Ix import Data.List import Data.Time.Calendar import Data.Time.Clock import Foreign.C.Types import Sync.MerkleTree.Analyse import Sync.MerkleTree.Run import Sync.MerkleTree.Client import System.Directory import System.FilePath import System.Posix.Files import System.IO import System.IO.Error import System.IO.Temp import System.Posix.Files import System.Random import qualified Test.HUnit as H tests :: H.Test tests = H.TestList $ [ testClockDriftFail , testOptions , testBigFile , testHelp , testCmdLine , testCmdLineFail , testExit , testEntry , testIgnoreBoring , testSync , testDoesThrowIOError , testDirsEqual ] testIgnoreBoring :: H.Test testIgnoreBoring = let testCase ign bor = withSystemTempDirectory "sync-mht" $ \fp -> do let srcDir = fp "src" destDir = fp "dest" createDirectory srcDir createDirectory $ srcDir "a" createDirectory $ srcDir "with-foo" createDirectory destDir writeFile (fp ".boring") $ unlines $ [ "#baz", "", "foo", "^bar" ] writeFile (srcDir "added.txt") "testA" writeFile (srcDir "added-bar.txt") "testB" writeFile (srcDir "baz") "testC" writeFile (srcDir "bar-ignore.txt") "testD" writeFile (srcDir "a" "bar") "testE" writeFile (srcDir "some-foo.txt") "testF" writeFile (srcDir "a" "foo") "testG" runSync $ defaultSyncOptions { so_source = Just $ srcDir , so_destination = Just $ destDir , so_ignore = ign , so_boring = map (const $ fp ".boring") bor , so_add = True , so_update = True , so_delete = True } readFile (destDir "added.txt") >>= ("testA" H.@=?) readFile (destDir "added-bar.txt") >>= ("testB" H.@=?) readFile (destDir "baz") >>= ("testC" H.@=?) doesFileExist (destDir "bar-ignore.txt") >>= (False H.@=?) readFile (destDir "a" "bar") >>= ("testE" H.@=?) doesFileExist (destDir "some-foo.txt") >>= (False H.@=?) doesFileExist (destDir "a" "foo") >>= (False H.@=?) (doesDirectoryExist $ destDir "with-foo") >>= (False H.@=?) in H.TestList [ H.TestLabel "testIgnore" $ H.TestCase $ testCase ["foo","^bar"] [] , H.TestLabel "testBoring" $ H.TestCase $ testCase [] [()] ] testBigFile :: H.Test testBigFile = H.TestLabel "testBigFile" $ H.TestCase $ withSystemTempDirectory "sync-mht" $ \testDir -> do let srcDir = testDir "src" destDir = testDir "dest" data_ = show [1..(2^17)] createDirectory srcDir forM_ [1..20] $ \i -> do createDirectory $ srcDir (show i) forM_ [1..20] $ \j -> writeFile (srcDir (show i) ("new.txt"++show j)) data_ createDirectory destDir runSync $ defaultSyncOptions { so_source = Just $ srcDir , so_destination = Just $ destDir , so_add = True } dataNew1 <- readFile $ destDir "1" "new.txt19" dataNew2 <- readFile $ destDir "17" "new.txt13" dataNew3 <- readFile $ destDir "12" "new.txt1" data_ H.@=? dataNew1 data_ H.@=? dataNew2 data_ H.@=? dataNew3 testCmdLine :: H.Test testCmdLine = H.TestLabel "testCmdLine" $ H.TestCase $ withSystemTempDirectory "sync-mht" $ \testDir -> do let srcDir = testDir "src" destDir = testDir "dest" boringFile = testDir ".boring" expected = show [1..(2^17)] createDirectory srcDir createDirectory destDir writeFile boringFile "$bar^" writeFile (srcDir "new.txt") expected runMain ["-s",srcDir,"-d",destDir,"-a","-u","--delete","-i","$foo^","-b",boringFile] got <- readFile $ destDir "new.txt" expected H.@=? got testCmdLineFail :: H.Test testCmdLineFail = H.TestLabel "testCmdLineFail" $ H.TestCase $ withSystemTempDirectory "sync-mht" $ \testDir -> do let srcDir = testDir "src" destDir = testDir "dest" expected = "test" createDirectory srcDir createDirectory destDir writeFile (srcDir "new.txt") expected runMain ["-s",srcDir,"-d",destDir,"foo","bar"] runMain ["-s",srcDir,"-d","remote:"++destDir,"-r","exit 0"] runMain ["-foobar"] runMain ["--help"] runMain ["-s",srcDir,"-d",destDir] (doesFileExist $ destDir "new.txt") >>= (False H.@=?) testClockDriftFail :: H.Test testClockDriftFail = H.TestLabel "testClockDriftFail" $ H.TestCase $ withSystemTempDirectory "sync-mht" $ \testDir -> do let srcDir = testDir "src" destDir = testDir "dest" expected = "expected" syncOpts = defaultSyncOptions { so_add = True , so_source = Just $ srcDir , so_destination = Just $ "remote:" ++ destDir , so_remote = Just Simulate } createDirectory srcDir createDirectory destDir writeFile (srcDir "new.txt") expected runSync $ syncOpts { so_compareClocks = Just (10.0, -100.0) } runSync $ syncOpts { so_compareClocks = Just (10.0, 100.0) } (doesFileExist $ destDir "new.txt") >>= (False H.@=?) runSync $ syncOpts { so_compareClocks = Just (10.0, 0.0) } got <- readFile $ destDir "new.txt" expected H.@=? got runMain :: [String] -> IO () runMain = main "" runSync :: SyncOptions -> IO () runSync = run "" testHelp :: H.Test testHelp = H.TestLabel "testHelp" $ H.TestCase $ withSystemTempDirectory "sync-mht" $ \testDir -> do let srcDir = testDir "src" destDir = testDir "dest" data_ = "d" syncOpts = defaultSyncOptions { so_add = True , so_source = Just $ srcDir , so_destination = Just $ destDir } createDirectory srcDir createDirectory destDir writeFile (srcDir "new.txt") data_ mapM (runSync) $ [ syncOpts { so_nonOptions = ["foo", "bar"] } , syncOpts { so_source = Just $ "remote:" ++ srcDir } , syncOpts { so_source = Nothing } , syncOpts { so_destination = Nothing } , syncOpts { so_source = Nothing, so_destination = Nothing } , defaultSyncOptions , syncOpts { so_remote = Just $ RemoteCmd "/bin/true" } , syncOpts { so_destination = Just $ "remote:" ++ destDir } , syncOpts { so_help = True } , syncOpts { so_source = Just $ "remote:" ++ srcDir , so_destination = Just $ "remote:" ++ destDir , so_remote = Just $ RemoteCmd "/bin/true" } ] (doesFileExist $ destDir "new.txt") >>= (False H.@=?) testExit :: H.Test testExit = H.TestLabel "testExit" $ H.TestCase $ withSystemTempDirectory "sync-mht" $ \testDir -> do let srcDir = testDir "src" destDir = testDir "dest" data_ = "d" createDirectory srcDir createDirectory destDir writeFile (srcDir "new.txt") data_ shouldFail $ do runSync $ defaultSyncOptions { so_source = Just $ "remote:" ++ srcDir , so_destination = Just $ destDir , so_remote = Just $ RemoteCmd "exit" , so_add = True } testOptions :: H.Test testOptions = H.TestLabel "testOptions" $ H.TestCase $ let prepare add update delete go = withSystemTempDirectory "sync-mht" $ \testDir -> do let srcDir = testDir "src" destDir = testDir "dest" createDirectory srcDir createDirectory destDir writeFile (srcDir "same.txt") "test" copyFile (srcDir "same.txt") (destDir "same.txt") writeFile (srcDir "changed.txt") "test" writeFile (destDir "changed.txt") "testB" writeFile (srcDir "added.txt") "test" writeFile (destDir "deleted.txt") "testB" runSync $ defaultSyncOptions { so_source = Just $ srcDir , so_destination = Just $ destDir , so_add = add , so_update = update , so_delete = delete } True <- liftM (=="test") $ readFile (srcDir "same.txt") True <- liftM (=="test") $ readFile (srcDir "changed.txt") True <- liftM (=="test") $ readFile (srcDir "added.txt") go destDir in do prepare True False False $ \destDir -> do readFile (destDir "same.txt") >>= ("test" H.@=?) readFile (destDir "changed.txt") >>= ("testB" H.@=?) readFile (destDir "added.txt") >>= ("test" H.@=?) readFile (destDir "deleted.txt") >>= ("testB" H.@=?) prepare False True False $ \destDir -> do readFile (destDir "same.txt") >>= ("test" H.@=?) readFile (destDir "changed.txt") >>= ("test" H.@=?) readFile (destDir "deleted.txt") >>= ("testB" H.@=?) prepare False False True $ \destDir -> do readFile (destDir "same.txt") >>= ("test" H.@=?) readFile (destDir "changed.txt") >>= ("testB" H.@=?) doesFileExist (destDir "deleted.txt") >>= (False H.@=?) testSync :: H.Test testSync = H.TestList $ flip map [0,1,2] $ \simulate -> H.TestLabel ("testSync"++ show simulate) $ H.TestCase $ forM_ [1..20] $ \_ -> withSystemTempDirectory "sync-mht" $ \testDir -> do mkRandomDir 4 [testDir "src", testDir "src-backup"] mkRandomDir 4 [testDir "target"] let sourcePrefix | simulate == 1 = "remote:" | otherwise = "" targetPrefix | simulate == 2 = "remote:" | otherwise = "" let cmd = runSync $ defaultSyncOptions { so_source = Just $ (sourcePrefix ++) testDir "src" , so_destination = Just $ (targetPrefix ++) testDir "target" , so_remote = case simulate of 0 -> Nothing _ -> Just Simulate , so_add = True , so_update = True , so_delete = True } cmd areDirsEqual (testDir "src") (testDir "target") areDirsEqual (testDir "src") (testDir "src-backup") cmd areDirsEqual (testDir "target") (testDir "src-backup") utcTimeFrom :: Integer -> CTime utcTimeFrom x = CTime (1000+ fromIntegral x) mkRandomDir :: Integer -> [FilePath] -> IO () mkRandomDir md fps = do forM fps createDirectory names <- distinctNames 6 forM_ names $ \n -> do genDir <- randomIO case () of () | genDir, md > 0 -> mkRandomDir (md - 1) $ map ( n) fps | genDir -> return () | otherwise -> do d <- randomRIO (1,4) forM_ fps $ \fp -> do writeFile (fp n) (show d) setFileTimes (fp n) (utcTimeFrom d) (utcTimeFrom d) doesThrowIOError :: IO () -> IO Bool doesThrowIOError a = catchIOError (a >>= (return . (`seq` False))) (return . (`seq` True)) shouldFail :: IO () -> IO () shouldFail action = doesThrowIOError action >>= (True H.@=?) testDoesThrowIOError :: H.Test testDoesThrowIOError = H.TestLabel "testDoesThrowIOError" $ H.TestCase $ do r1 <- doesThrowIOError $ return () False H.@=? r1 testDirsEqual :: H.Test testDirsEqual = H.TestLabel "testDirsEqual" $ H.TestCase $ shouldFail $ withSystemTempDirectory "sync-mht" $ \testDir -> do createDirectory $ testDir "a" createDirectory $ testDir "b" writeFile (testDir "a" "x") "x" writeFile (testDir "b" "x") "y" areDirsEqual (testDir "a") (testDir "b") areDirsEqual :: FilePath -> FilePath -> IO () areDirsEqual fp1 fp2 = do files1 <- liftM (sort . filter isRealFile) $ getDirectoryContents fp1 files2 <- liftM (sort . filter isRealFile) $ getDirectoryContents fp2 case () of () | files1 == files2 -> forM_ files1 $ \f -> areEntriesEqual (fp1 f) (fp2 f) | otherwise -> fail $ "Unequal: " ++ show (fp1, fp2, files1, files2) areEntriesEqual :: FilePath -> FilePath -> IO () areEntriesEqual f1 f2 = do s1 <- getFileStatus f1 s2 <- getFileStatus f2 case () of () | isDirectory s1, isDirectory s2 -> areDirsEqual f1 f2 | isRegularFile s1, isRegularFile s2 -> do c1 <- readFile f1 c2 <- readFile f2 unless (c1 == c2) $ fail $ "Unequal files: " ++ show (f1, f2, c1, c2) | otherwise -> fail $ show (f1, f2, isDirectory s1, isDirectory s2, isRegularFile s1, isRegularFile s2) -- | @distinctNames k@ creates k distinct file names distinctNames :: Integer -> IO [String] distinctNames k = retry where isDistinct names = null $ filter hasDuplicate $ group $ sort names hasDuplicate = (/= 1) . length mkName _ = liftM (:[]) $ randomRIO ('a','m') retry = do result <- forM [1..k] mkName if isDistinct result then return result else retry