summaryrefslogtreecommitdiff
path: root/git-repair-test.hs
blob: 8256d3129aa0e81a201432400fc43336c1a7e342 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
{- Test runner
 -
 - Passed a git repository, makes a temporary clone of the git repository,
 - corrupts part of it, then tries to repair it, and logs the result.
 -}

module Main where

import Options.Applicative

import Common
import qualified Git.Construct
import qualified Git.Config
import qualified Git.Destroyer
import qualified Git.Repair
import qualified Git.Fsck
import Utility.Tmp

data Settings = Settings
	{ originalGitRepo :: FilePath
	, forced :: Bool
	, retryMode :: Bool
	, stopOnFailure :: Bool
	, numTests :: Int
	}

parseSettings :: Parser Settings
parseSettings = Settings
	<$> argument str
		(metavar "REPO")
        <*> switch
		( long "force"
		<> help "Force repair"
		)
	<*> switch
		( long "retry"
		<> help "Retry tests in git-repair-test.log"
		)
	<*> switch
		( long "stop-on-failure"
		<> help "Stop running tests on failure"
		)
	<*> option
		( long "numtests"
		<> short 'n'
		<> metavar "N"
		<> help "Run N tests"
		<> value 1
		)

main :: IO ()
main = execParser opts >>= run
  where
	opts = info (helper <*> parseSettings) desc
	desc = fullDesc
		<> header "git-repair-test - test git-repair"

run :: Settings -> IO ()
run settings
	| retryMode settings = do
		l <- map Prelude.read . lines <$> readFile logFile
		go $ forM l $ \damage -> 
			runTest settings damage >>= showTestResult settings
	| otherwise =
		go $ forM [1 .. numTests settings] $ \n -> do
			putStrLn $ "** Test " ++ show n ++ "/" ++ show (numTests settings)
			runRandomTest settings
  where
	go a = exitBool . and =<< a

runRandomTest :: Settings -> IO Bool
runRandomTest settings = do
	damage <- Git.Destroyer.generateDamage
	logDamage damage
	result <- runTest settings damage
	showTestResult settings result

runTest :: Settings -> [Git.Destroyer.Damage] -> IO TestResult
runTest settings damage = withTmpDir "tmprepo" $ \tmpdir -> do
	let cloneloc = tmpdir </> "clone"
	cloned <- boolSystem "git"
		[ Param "clone"
		, Param "--no-hardlinks"
		, File (originalGitRepo settings)
		, File cloneloc
		]
	unless cloned $
		error $ "failed to clone " ++ originalGitRepo settings
	g <- Git.Config.read =<< Git.Construct.fromPath cloneloc
	Git.Destroyer.applyDamage damage g
	repairstatus <- catchMaybeIO $ Git.Repair.successfulRepair
		<$> Git.Repair.runRepair (forced settings) g
	case repairstatus of
		Just True -> TestResult damage repairstatus 
			. Just . not . Git.Fsck.foundBroken
			<$> Git.Fsck.findBroken False g
		_ -> return $ TestResult damage repairstatus Nothing

data TestResult = TestResult
	{ damageList :: [Git.Destroyer.Damage]
	, repairResult :: Maybe Bool
	, fsckResult ::  Maybe Bool
	}
	deriving (Read, Show)

showTestResult :: Settings -> TestResult -> IO Bool
showTestResult settings testresult = do
	ok <- case (repairResult testresult, fsckResult testresult) of
		(Just True, Just True) -> do
			putStrLn "** repair succeeded"
			return True
		(Just True, Just False) -> do
			putStrLn "** repair succeeded, but final fsck failed"
			return False
		_ -> do
			putStrLn "** repair failed"
			return False
	when (stopOnFailure settings && not ok) $
		exitFailure
	return ok

logDamage :: [Git.Destroyer.Damage] -> IO ()
logDamage damage = appendFile logFile $ show damage ++ "\n"

logFile :: FilePath
logFile = "git-repair-test.log"