0a17cc0 · obelisk · git.iko.soy

git.iko.soy/obelisk

on master help sign in

selftest: Create new git repo from working directory to support selftest on dirty repo

0a17cc0Elliot Cameron7 years ago

default.nix+1

compare with master

unifiedsplit

@@ -82,6 +82,7 @@ let

82 pkgs.coreutils

83 pkgs.git

84 pkgs.nix

85+ pkgs.rsync

85 ];

86 ];

86 };

87 };

87 obelisk-snap-extras = self.callCabal2nix "obelisk-snap-extras" (cleanSource ./lib/snap-extras) {};

88 obelisk-snap-extras = self.callCabal2nix "obelisk-snap-extras" (cleanSource ./lib/snap-extras) {};

lib/selftest/src/Obelisk/SelfTest.hs+42−25

@@ -26,11 +26,12 @@ import Shelly

26import System.Directory (getCurrentDirectory, withCurrentDirectory, getDirectoryContents)

27import System.Environment

28import System.Exit (ExitCode (..))

29−import System.Which (staticWhich)

29+import System.FilePath (addTrailingPathSeparator)

30import qualified System.Info

31import System.IO (Handle, hClose, hIsEOF, hGetContents)

32import System.IO.Temp

33import System.Process (readProcessWithExitCode)

34+import System.Which (staticWhich)

34import Test.Hspec

35import Test.Hspec

35import Test.HUnit.Base

36import Test.HUnit.Base

@@ -70,6 +71,9 @@ lnPath = $(staticWhich "ln")

70rmPath :: FilePath

71rmPath :: FilePath

71rmPath = $(staticWhich "rm")

72rmPath = $(staticWhich "rm")

74+rsyncPath :: FilePath

75+rsyncPath = $(staticWhich "rsync")

76+

73gitUserConfig :: [Text]

77gitUserConfig :: [Text]

74gitUserConfig = ["-c", "user.name=Obelisk Selftest", "-c", "user.email=noreply@example.com"]

78gitUserConfig = ["-c", "user.name=Obelisk Selftest", "-c", "user.email=noreply@example.com"]

@@ -97,6 +101,29 @@ ob = "ob"

97augmentWithVerbosity :: (String -> [Text] -> a) -> String -> Bool -> [Text] -> a

101augmentWithVerbosity :: (String -> [Text] -> a) -> String -> Bool -> [Text] -> a

98augmentWithVerbosity runner executable isVerbose args = runner executable $ (if isVerbose then ("-v" :) else id) args

102augmentWithVerbosity runner executable isVerbose args = runner executable $ (if isVerbose then ("-v" :) else id) args

103

104+-- | Copies a git repo to a new location and "resets" the git history to include

105+-- exactly one commit with all files added. It then restricts writing and reading

106+-- for group and user to make the repo ideal for being a valid git remote for thunks.

107+--

108+-- Using this allows dirty repos to be used as git remotes during the test since 'git clone'ing

109+-- a dirty repo will not include the uncommitted changes.

110+copyForGitRemote :: Bool -> FilePath -> FilePath -> IO ()

111+copyForGitRemote isVerbose origDir copyDir = shelly $ bool silently verbosely isVerbose $ do

112+ setenv "HOME" "/dev/null"

113+ setenv "GIT_CONFIG_NOSYSTEM" "1"

114+ run_ rsyncPath

115+ [ "-r", "--no-perms", "--no-owner", "--no-group", "--exclude", ".git"

116+ , toTextIgnore (addTrailingPathSeparator origDir), toTextIgnore copyDir

117+ ]

118+ git ["init"]

119+ git ["config", "user.name", "SelfTest"]

120+ git ["config", "user.email", "self@test"]

121+ git ["add", "--all"]

122+ git ["commit", "-m", "Copy repo"]

123+ run_ chmodPath ["-R", "u-w,g-rw,o-rw", toTextIgnore copyDir] -- Freeze this state

124+ where

125+ git args = run_ gitPath $ ["-C", toTextIgnore copyDir] <> args

126+

100main :: IO ()

127main :: IO ()

101main = do

128main = do

102 -- Note: you can pass hspec arguments as well, eg: `-m <pattern>`

129 -- Note: you can pass hspec arguments as well, eg: `-m <pattern>`

@@ -104,13 +131,15 @@ main = do

104 unless isVerbose $

131 unless isVerbose $

105 putStrLn "Tests may take longer to run if there are unbuilt derivations: use -v for verbose output"

132 putStrLn "Tests may take longer to run if there are unbuilt derivations: use -v for verbose output"

106

133

107− obeliskImplDirtyReadOnly <- fromString <$> getCurrentDirectory

134+ obeliskImplDirtyReadOnly <- getCurrentDirectory

108 httpManager <- HTTP.newManager HTTP.defaultManagerSettings

135 httpManager <- HTTP.newManager HTTP.defaultManagerSettings

109

136

137+ withSystemTempDirectory "obelisk-repo-git-remote" $ \copyDir -> do

138+ copyForGitRemote isVerbose obeliskImplDirtyReadOnly copyDir

110− main' isVerbose httpManager obeliskImplDirtyReadOnly

139+ main' isVerbose httpManager copyDir

111

140

112main' :: Bool -> HTTP.Manager -> FilePath -> IO ()

141main' :: Bool -> HTTP.Manager -> FilePath -> IO ()

113−main' isVerbose httpManager obeliskRepoReadOnly = withObeliskImplDirtyAndInitCache $ \obeliskImplDirty initCache -> hspec $ parallel $ do

142+main' isVerbose httpManager obeliskRepoReadOnly = withInitCache $ \initCache -> hspec $ parallel $ do

114 let

143 let

115 inTmpObInit' dirname f = inTmp' dirname $ \dir -> do

144 inTmpObInit' dirname f = inTmp' dirname $ \dir -> do

116 run_ cpPath ["-rT", fromString initCache, toTextIgnore dir]

145 run_ cpPath ["-rT", fromString initCache, toTextIgnore dir]

@@ -127,7 +156,7 @@ main' isVerbose httpManager obeliskRepoReadOnly = withObeliskImplDirtyAndInitCac

127 describe "ob init" $ parallel $ do

156 describe "ob init" $ parallel $ do

128 it "works with default impl" $ inTmp $ \_ -> runOb ["init"]

157 it "works with default impl" $ inTmp $ \_ -> runOb ["init"]

129 it "works with master branch impl" $ inTmp $ \_ -> runOb ["init", "--branch", "master"]

158 it "works with master branch impl" $ inTmp $ \_ -> runOb ["init", "--branch", "master"]

130− it "works with symlink" $ inTmp $ \_ -> runOb ["init", "--symlink", toTextIgnore obeliskImplDirty]

159+ it "works with symlink" $ inTmp $ \_ -> runOb ["init", "--symlink", toTextIgnore obeliskRepoReadOnly]

131 it "doesn't silently overwrite existing files" $ inTmp $ \_ -> do

160 it "doesn't silently overwrite existing files" $ inTmp $ \_ -> do

132 let p force = errExit False $ do

161 let p force = errExit False $ do

133 run_ ob $ "--no-handoff" : "-v" : "init" : ["--force"|force]

162 run_ ob $ "--no-handoff" : "-v" : "init" : ["--force"|force]

@@ -154,10 +183,10 @@ main' isVerbose httpManager obeliskRepoReadOnly = withObeliskImplDirtyAndInitCac

154 it "works in sub directory" $ inTmpObInit $ \_ -> testObRunInDir' (Just "frontend") httpManager

183 it "works in sub directory" $ inTmpObInit $ \_ -> testObRunInDir' (Just "frontend") httpManager

155

184

156 describe "obelisk project" $ parallel $ do

185 describe "obelisk project" $ parallel $ do

157− it "can build obelisk command" $ inTmpObInit $ \_ -> nixBuild ["-A", "command" , toTextIgnore obeliskImplDirty]

186+ it "can build obelisk command" $ inTmpObInit $ \_ -> nixBuild ["-A", "command" , toTextIgnore obeliskRepoReadOnly]

158− it "can build obelisk skeleton" $ inTmpObInit $ \_ -> nixBuild ["-A", "skeleton", toTextIgnore obeliskImplDirty]

187+ it "can build obelisk skeleton" $ inTmpObInit $ \_ -> nixBuild ["-A", "skeleton", toTextIgnore obeliskRepoReadOnly]

159− it "can build obelisk shell" $ inTmpObInit $ \_ -> nixBuild ["-A", "shell", toTextIgnore obeliskImplDirty]

188+ it "can build obelisk shell" $ inTmpObInit $ \_ -> nixBuild ["-A", "shell", toTextIgnore obeliskRepoReadOnly]

160− it "can build everything" $ inTmpObInit $ \_ -> nixBuild [toTextIgnore obeliskImplDirty]

189+ it "can build everything" $ inTmpObInit $ \_ -> nixBuild [toTextIgnore obeliskRepoReadOnly]

161

190

162 describe "blank initialized project" $ parallel $ do

191 describe "blank initialized project" $ parallel $ do

163

192

@@ -274,34 +303,22 @@ main' isVerbose httpManager obeliskRepoReadOnly = withObeliskImplDirtyAndInitCac

274 testThunkPack' = augmentWithVerbosity testThunkPack ob isVerbose []

303 testThunkPack' = augmentWithVerbosity testThunkPack ob isVerbose []

275

304

276 withObeliskImplClean f =

305 withObeliskImplClean f =

277− withSystemTempDirectory "obelisk-impl-clean" $ \(fromString -> obeliskImpl) -> do

306+ withSystemTempDirectory "obelisk-impl-clean" $ \obeliskImpl -> do

278 void . shellyOb verbosity $ chdir obeliskImpl $ do

307 void . shellyOb verbosity $ chdir obeliskImpl $ do

279 dirtyFiles <- T.strip <$> run gitPath ["-C", toTextIgnore obeliskRepoReadOnly, "diff", "--stat"]

308 dirtyFiles <- T.strip <$> run gitPath ["-C", toTextIgnore obeliskRepoReadOnly, "diff", "--stat"]

280− () <- when (dirtyFiles /= "") $ error "SelfTest does not work correctly on dirty repo"

309+ () <- when (dirtyFiles /= "") $ error "SelfTest does not work correctly with dirty obelisk repos as remote"

281 run_ gitPath ["clone", "file://" <> toTextIgnore obeliskRepoReadOnly, toTextIgnore obeliskImpl]

310 run_ gitPath ["clone", "file://" <> toTextIgnore obeliskRepoReadOnly, toTextIgnore obeliskImpl]

282 f obeliskImpl

311 f obeliskImpl

283

312

284− withObeliskImplDirty f =

285− withSystemTempDirectory "obelisk-impl-copy" $ \(fromString -> obeliskImpl) -> do

286− void . shellyOb verbosity $ chdir obeliskImpl $ do

287− user <- T.strip <$> run whoamiPath []

288− run_ cpPath ["-rT", "--no-preserve=mode", toTextIgnore obeliskRepoReadOnly, toTextIgnore obeliskImpl]

289− run_ chownPath ["-R", user, toTextIgnore obeliskImpl]

290− run_ chmodPath ["-R", "g-rw,o-rw", toTextIgnore obeliskImpl]

291− f obeliskImpl

292−

293− withInitCache f obeliskImpl =

313+ withInitCache f =

294 withSystemTempDirectory "init Cache λ" $ \initCache -> do

314 withSystemTempDirectory "init Cache λ" $ \initCache -> do

295 -- Setup the ob init cache

315 -- Setup the ob init cache

296 void . shellyOb verbosity $ chdir initCache $ do

316 void . shellyOb verbosity $ chdir initCache $ do

297− runOb_ ["init", "--symlink", toTextIgnore obeliskImpl]

317+ runOb_ ["init", "--symlink", toTextIgnore obeliskRepoReadOnly]

298 run_ gitPath ["init"]

318 run_ gitPath ["init"]

299

319

300 f initCache

320 f initCache

301

321

302− withObeliskImplDirtyAndInitCache f =

303− withObeliskImplDirty $ \impl -> withInitCache (f impl) impl

304−

305 shelly_ = void . shellyOb verbosity

322 shelly_ = void . shellyOb verbosity

306

323

307 defaultTmpDirName = "test λ"

324 defaultTmpDirName = "test λ"