on master help sign in
selftest: Create new git repo from working directory to support selftest on dirty repo
commit0a17cc03803cdde57edb49d247b04d844be566bf authorElliot Cameron <eacameron@gmail.com> dateThu 19 Mar 2020, 14:55 (7 years ago) parent2f6fa1b
2 files changed+43−25
default.nix+1 lib/selftest/src/Obelisk/SelfTest.hs+42−25
default.nix+1
@@ -82,6 +82,7 @@ let
8282 pkgs.coreutils
8383 pkgs.git
8484 pkgs.nix
85+ pkgs.rsync
8586 ];
8687 };
8788 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
2626import System.Directory (getCurrentDirectory, withCurrentDirectory, getDirectoryContents)
2727import System.Environment
2828import System.Exit (ExitCode (..))
29−import System.Which (staticWhich)
29+import System.FilePath (addTrailingPathSeparator)
3030import qualified System.Info
3131import System.IO (Handle, hClose, hIsEOF, hGetContents)
3232import System.IO.Temp
3333import System.Process (readProcessWithExitCode)
34+import System.Which (staticWhich)
3435import Test.Hspec
3536import Test.HUnit.Base
3637
@@ -70,6 +71,9 @@ lnPath = $(staticWhich "ln")
7071rmPath :: FilePath
7172rmPath = $(staticWhich "rm")
7273
74+rsyncPath :: FilePath
75+rsyncPath = $(staticWhich "rsync")
76+
7377gitUserConfig :: [Text]
7478gitUserConfig = ["-c", "user.name=Obelisk Selftest", "-c", "user.email=noreply@example.com"]
7579
@@ -97,6 +101,29 @@ ob = "ob"
97101augmentWithVerbosity :: (String -> [Text] -> a) -> String -> Bool -> [Text] -> a
98102augmentWithVerbosity runner executable isVerbose args = runner executable $ (if isVerbose then ("-v" :) else id) args
99103
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+
100127main :: IO ()
101128main = do
102129 -- Note: you can pass hspec arguments as well, eg: `-m <pattern>`
@@ -104,13 +131,15 @@ main = do
104131 unless isVerbose $
105132 putStrLn "Tests may take longer to run if there are unbuilt derivations: use -v for verbose output"
106133
107− obeliskImplDirtyReadOnly <- fromString <$> getCurrentDirectory
134+ obeliskImplDirtyReadOnly <- getCurrentDirectory
108135 httpManager <- HTTP.newManager HTTP.defaultManagerSettings
109136
110− main' isVerbose httpManager obeliskImplDirtyReadOnly
137+ withSystemTempDirectory "obelisk-repo-git-remote" $ \copyDir -> do
138+ copyForGitRemote isVerbose obeliskImplDirtyReadOnly copyDir
139+ main' isVerbose httpManager copyDir
111140
112141main' :: 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
114143 let
115144 inTmpObInit' dirname f = inTmp' dirname $ \dir -> do
116145 run_ cpPath ["-rT", fromString initCache, toTextIgnore dir]
@@ -127,7 +156,7 @@ main' isVerbose httpManager obeliskRepoReadOnly = withObeliskImplDirtyAndInitCac
127156 describe "ob init" $ parallel $ do
128157 it "works with default impl" $ inTmp $ \_ -> runOb ["init"]
129158 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]
131160 it "doesn't silently overwrite existing files" $ inTmp $ \_ -> do
132161 let p force = errExit False $ do
133162 run_ ob $ "--no-handoff" : "-v" : "init" : ["--force"|force]
@@ -154,10 +183,10 @@ main' isVerbose httpManager obeliskRepoReadOnly = withObeliskImplDirtyAndInitCac
154183 it "works in sub directory" $ inTmpObInit $ \_ -> testObRunInDir' (Just "frontend") httpManager
155184
156185 describe "obelisk project" $ parallel $ do
157− it "can build obelisk command" $ inTmpObInit $ \_ -> nixBuild ["-A", "command" , toTextIgnore obeliskImplDirty]
158− it "can build obelisk skeleton" $ inTmpObInit $ \_ -> nixBuild ["-A", "skeleton", toTextIgnore obeliskImplDirty]
159− it "can build obelisk shell" $ inTmpObInit $ \_ -> nixBuild ["-A", "shell", toTextIgnore obeliskImplDirty]
160− it "can build everything" $ inTmpObInit $ \_ -> nixBuild [toTextIgnore obeliskImplDirty]
186+ it "can build obelisk command" $ inTmpObInit $ \_ -> nixBuild ["-A", "command" , toTextIgnore obeliskRepoReadOnly]
187+ it "can build obelisk skeleton" $ inTmpObInit $ \_ -> nixBuild ["-A", "skeleton", toTextIgnore obeliskRepoReadOnly]
188+ it "can build obelisk shell" $ inTmpObInit $ \_ -> nixBuild ["-A", "shell", toTextIgnore obeliskRepoReadOnly]
189+ it "can build everything" $ inTmpObInit $ \_ -> nixBuild [toTextIgnore obeliskRepoReadOnly]
161190
162191 describe "blank initialized project" $ parallel $ do
163192
@@ -274,34 +303,22 @@ main' isVerbose httpManager obeliskRepoReadOnly = withObeliskImplDirtyAndInitCac
274303 testThunkPack' = augmentWithVerbosity testThunkPack ob isVerbose []
275304
276305 withObeliskImplClean f =
277− withSystemTempDirectory "obelisk-impl-clean" $ \(fromString -> obeliskImpl) -> do
306+ withSystemTempDirectory "obelisk-impl-clean" $ \obeliskImpl -> do
278307 void . shellyOb verbosity $ chdir obeliskImpl $ do
279308 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"
281310 run_ gitPath ["clone", "file://" <> toTextIgnore obeliskRepoReadOnly, toTextIgnore obeliskImpl]
282311 f obeliskImpl
283312
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 =
294314 withSystemTempDirectory "init Cache λ" $ \initCache -> do
295315 -- Setup the ob init cache
296316 void . shellyOb verbosity $ chdir initCache $ do
297− runOb_ ["init", "--symlink", toTextIgnore obeliskImpl]
317+ runOb_ ["init", "--symlink", toTextIgnore obeliskRepoReadOnly]
298318 run_ gitPath ["init"]
299319
300320 f initCache
301321
302− withObeliskImplDirtyAndInitCache f =
303− withObeliskImplDirty $ \impl -> withInitCache (f impl) impl
304−
305322 shelly_ = void . shellyOb verbosity
306323
307324 defaultTmpDirName = "test λ"