8e70fc0 · obelisk · git.iko.soy

git.iko.soy/obelisk

Merge pull request #711 from obsidiansystems/eac@no-local-dir-in-thunks

command: Unpack latest thunk type inplace instead of in local

commit8e70fc0665bc447f1391ff88e65b6572f6cc5f62 authorElliot Cameron <3noch@users.noreply.github.com> dateWed 22 Apr 2020, 10:57 (6 years ago) parent45d14f3 33053b4

4 files changed+25−44

compare with master

unifiedsplit

all-tests.nix+6−6 lib/command/src/Obelisk/Command.hs−3 lib/command/src/Obelisk/Command/Thunk.hs+18−28 lib/selftest/src/Obelisk/SelfTest.hs+1−7

all-tests.nix+6−6

@@ -125,17 +125,17 @@ in

125125 client.succeed("ob -v thunk unpack ~/code/myapp")

126126

127127 with subtest("building an invalid thunk fails"):

128− client.succeed("cd ~/code/myapp/local && git checkout -b bad")

128+ client.succeed("cd ~/code/myapp && git checkout -b bad")

129129 client.succeed(

130− "cp ${invalidThunkableSample} ~/code/myapp/local/default.nix"

130+ "cp ${invalidThunkableSample} ~/code/myapp/default.nix"

131131 )

132− client.succeed("cd ~/code/myapp/local && git add .")

133− client.succeed('cd ~/code/myapp/local && git commit -m "Bad commit"')

134− client.succeed("cd ~/code/myapp/local && git push -u origin bad")

132+ client.succeed("cd ~/code/myapp && git add .")

133+ client.succeed('cd ~/code/myapp && git commit -m "Bad commit"')

134+ client.succeed("cd ~/code/myapp && git push -u origin bad")

135135 client.succeed("ob -v thunk pack ~/code/myapp --public")

136136 client.fail("nix-build ~/code/myapp")

137137 client.succeed("ob -v thunk unpack ~/code/myapp")

138− client.succeed("cd ~/code/myapp/local && git checkout master")

138+ client.succeed("cd ~/code/myapp && git checkout master")

139139

140140 with subtest("obelisk can detect private repos"):

141141 client.succeed("ob -v thunk pack ~/code/myapp")

lib/command/src/Obelisk/Command.hs−3

@@ -225,7 +225,6 @@ data ThunkCommand

225225 = ThunkCommand_Update ThunkUpdateConfig

226226 | ThunkCommand_Unpack

227227 | ThunkCommand_Pack ThunkPackConfig

228− | ThunkCommand_Init

229228 deriving Show

230229

231230thunkOption :: Parser ThunkOption

@@ -233,7 +232,6 @@ thunkOption = hsubparser $ mconcat

233232 [ command "update" $ info (thunkOptionWith $ ThunkCommand_Update <$> thunkUpdateConfig) $ progDesc "Update packed thunk to latest revision available on the tracked branch"

234233 , command "unpack" $ info (thunkOptionWith $ pure ThunkCommand_Unpack) $ progDesc "Unpack thunk into git checkout of revision it points to"

235234 , command "pack" $ info (thunkOptionWith $ ThunkCommand_Pack <$> thunkPackConfig) $ progDesc "Pack git checkout or unpacked thunk into thunk that points at the current branch's upstream"

236− , command "init" $ info (thunkOptionWith $ pure ThunkCommand_Init) $ progDesc "Initialize git checkout by converting it to an unpacked thunk"

237235 ]

238236 where

239237 thunkOptionWith f = ThunkOption

@@ -390,7 +388,6 @@ ob = \case

390388 ThunkCommand_Update config -> for_ thunks (updateThunkToLatest config)

391389 ThunkCommand_Unpack -> for_ thunks unpackThunk

392390 ThunkCommand_Pack config -> for_ thunks (packThunk config)

393− ThunkCommand_Init -> for_ thunks initThunk

394391 where

395392 thunks = _thunkOption_thunks to

396393 ObCommand_Repl interpretPathsList -> withInterpretPaths interpretPathsList runRepl

lib/command/src/Obelisk/Command/Thunk.hs+18−28

@@ -14,13 +14,14 @@ import Control.Applicative

1414import Control.Exception (displayException, try)

1515import Control.Lens (ifor, ifor_, (.~))

1616import Control.Monad

17−import Control.Monad.Extra (findM, unlessM, whenM)

17+import Control.Monad.Extra (findM)

1818import Control.Monad.Catch (MonadCatch, handle)

1919import Control.Monad.Except

2020import Data.Aeson ((.=))

2121import qualified Data.Aeson as Aeson

2222import Data.Aeson.Encode.Pretty

2323import qualified Data.Aeson.Types as Aeson

24+import Data.Bifunctor (first)

2425import qualified Data.ByteString.Lazy as LBS

2526import Data.Containers.ListUtils (nubOrd)

2627import Data.Default

@@ -208,7 +209,7 @@ data ReadThunkError

208209 deriving (Show)

209210

210211unpackedDirName :: FilePath

211−unpackedDirName = "local"

212+unpackedDirName = "."

212213

213214attrCacheFileName :: FilePath

214215attrCacheFileName = ".attr-cache"

@@ -356,7 +357,7 @@ overwriteThunk target thunk = do

356357 Right _ -> pure ()

357358

358359 --TODO: Is there a safer way to do this overwriting?

359− callProcessAndLogOutput (Debug, Error) $ proc rmPath ["-r", target] -- target may be a symlink

360+ liftIO $ removePathForcibly target

360361 createThunk target $ Right thunk

361362

362363thunkPtrToSpec :: ThunkPtr -> ThunkSpec

@@ -409,21 +410,6 @@ encodeThunkPtrData (ThunkPtr rev src) = case src of

409410 , confTrailingNewline = True

410411 }

411412

412−-- | Initialize a git repository to an unpacked thunk.

413−initThunk :: MonadObelisk m => FilePath -> m ()

414−initThunk target = withSpinner [i|Initializing thunk at ${target}|] $ do

415− checkThunkDirectory target

416− unlessM (liftIO $ doesDirectoryExist $ target </> ".git") $ failWith [i|${target} is not a git checkout.|]

417− ptr <- getThunkPtr CheckClean_NoCheck target Nothing

418− let tempThunkDir = target <.> "thunk-init"

419− whenM (liftIO $ doesPathExist tempThunkDir) $

420− failWith [i|A previous 'thunk init' left unfinished state at ${tempThunkDir}. You will need to rename or remove that path before trying again.|]

421− createThunk tempThunkDir $ Left (thunkPtrToSpec ptr) -- Only write the skeleton, but skip the ptr itself since it's unpacked

422− liftIO $ do

423− renameDirectory target (tempThunkDir </> unpackedDirName)

424− removePathForcibly target

425− renameDirectory tempThunkDir target

426−

427413createThunk :: MonadObelisk m => FilePath -> Either ThunkSpec ThunkPtr -> m ()

428414createThunk target ptrInfo =

429415 ifor_ (_thunkSpec_files spec) $ \path -> \case

@@ -555,7 +541,7 @@ let fetch = { private ? false, fetchSubmodules ? false, owner, repo, rev, sha256

555541 inherit owner repo rev sha256 fetchSubmodules private;

556542 };

557543 json = builtins.fromJSON (builtins.readFile ./github.json);

558−in if builtins.pathExists ./local then ./local else fetch json

544+in fetch json

559545|]

560546

561547parseGitHubJsonBytes :: LBS.ByteString -> Either String ThunkPtr

@@ -647,7 +633,7 @@ let fetch = {url, rev, branch ? null, sha256 ? null, fetchSubmodules ? false, pr

647633 url = realUrl; inherit rev sha256;

648634 };

649635 json = builtins.fromJSON (builtins.readFile ./git.json);

650−in if builtins.pathExists ./local then ./local else fetch json

636+in fetch json

651637|]

652638

653639parseGitJsonBytes :: LBS.ByteString -> Either String ThunkPtr

@@ -659,7 +645,7 @@ mkThunkSpec name jsonFileName parser srcNix = ThunkSpec name $ Map.fromList

659645 , ("thunk.nix", ThunkFileSpec_FileMatches srcNix)

660646 , (jsonFileName, ThunkFileSpec_Ptr parser)

661647 , (attrCacheFileName, ThunkFileSpec_AttrCache)

662− , (unpackedDirName, ThunkFileSpec_CheckoutIndicator)

648+ , (normalise $ unpackedDirName </> ".git", ThunkFileSpec_CheckoutIndicator)

663649 ]

664650 where

665651 defaultNixViaSrc = [here|

@@ -773,9 +759,6 @@ updateThunk p f = withSystemTempDirectory "obelisk-thunkptr-" $ \tmpDir -> do

773759finalMsg :: Bool -> (a -> Text) -> Maybe (a -> Text)

774760finalMsg noTrail s = if noTrail then Nothing else Just s

775761

776−unpackThunk :: MonadObelisk m => FilePath -> m ()

777−unpackThunk = unpackThunk' False

778−

779762-- | Check that we are not somewhere inside the thunk directory

780763checkThunkDirectory :: MonadObelisk m => FilePath -> m ()

781764checkThunkDirectory thunkDir = do

@@ -790,6 +773,9 @@ checkThunkDirectory thunkDir = do

790773 Right _ -> failWith [i|Refusing to perform thunk operation on ${thunkDir} because it is a thunk's unpacked source|]

791774 Left _ -> pure ()

792775

776+unpackThunk :: MonadObelisk m => FilePath -> m ()

777+unpackThunk = unpackThunk' False

778+

793779unpackThunk' :: MonadObelisk m => Bool -> FilePath -> m ()

794780unpackThunk' noTrail thunkDir = checkThunkDirectory thunkDir *> readThunk thunkDir >>= \case

795781 Left err -> failWith [i|Invalid thunk at ${thunkDir}: ${err}|]

@@ -805,9 +791,12 @@ unpackThunk' noTrail thunkDir = checkThunkDirectory thunkDir *> readThunk thunkD

805791 ThunkSource_Git _ -> NonEmpty.head gitThunkSpecs

806792 withSpinner' ("Fetching thunk " <> T.pack thunkName)

807793 (finalMsg noTrail $ const $ "Fetched thunk " <> T.pack thunkName) $ do

808− gitCloneForThunkUnpack gitSrc (_thunkRev_commit $ _thunkPtr_rev tptr) (tmpThunk </> unpackedDirName)

794+ let unpackedPath = tmpThunk </> unpackedDirName

795+ gitCloneForThunkUnpack gitSrc (_thunkRev_commit $ _thunkPtr_rev tptr) unpackedPath

809796

810− createThunk tmpThunk $ Left newSpec

797+ let normalizeMore = dropTrailingPathSeparator . normalise

798+ when (normalizeMore unpackedPath /= normalizeMore tmpThunk) $ -- Only write meta data if the checkout is not inplace

799+ createThunk tmpThunk $ Left newSpec

811800

812801 liftIO $ do

813802 removePathForcibly thunkDir

@@ -843,7 +832,7 @@ packThunk' noTrail (ThunkPackConfig force thunkConfig) thunkDir = checkThunkDire

843832 do

844833 let checkClean = if force then CheckClean_NoCheck else CheckClean_FullCheck

845834 thunkPtr <- modifyThunkPtrByConfig thunkConfig <$> getThunkPtr checkClean thunkDir (_thunkConfig_private thunkConfig)

846− callProcessAndLogOutput (Debug, Error) $ proc rmPath ["-rf", thunkDir] -- thunkDir may be a symlink

835+ liftIO $ removePathForcibly thunkDir

847836 createThunk thunkDir $ Right thunkPtr

848837 pure thunkPtr

849838

@@ -865,7 +854,8 @@ data CheckClean

865854

866855getThunkPtr :: forall m. MonadObelisk m => CheckClean -> FilePath -> Maybe Bool -> m ThunkPtr

867856getThunkPtr gitCheckClean dir mPrivate = do

868− let repoLocations = [(".git", "."), (unpackedDirName, unpackedDirName)]

857+ let repoLocations = nubOrd $ map (first normalise)

858+ [(".git", "."), (unpackedDirName </> ".git", unpackedDirName)]

869859 repoLocation' <- liftIO $ flip findM repoLocations $ doesDirectoryExist . (dir </>) . fst

870860 thunkDir <- case repoLocation' of

871861 Nothing -> failWith [i|Can't find an unpacked thunk in ${dir}|]

lib/selftest/src/Obelisk/SelfTest.hs+1−7

@@ -336,7 +336,6 @@ main' isVerbose httpManager obeliskRepoReadOnly = withInitCache $ \initCache ->

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

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

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

339− runOb_ ["thunk", "init", toTextIgnore obeliskImpl]

340339 f obeliskImpl

341340

342341 withInitCache f =

@@ -498,14 +497,9 @@ testLegacyGitThunks isVerbose = withSystemTempDirectory "test-git-repo" $ \gitDi

498497

499498 for_ (legacyGitThunks (GitThunkParams gitDir rev sha256)) $ \mkFiles ->

500499 withSystemTempDirectory "test-thunks" $ \thunkDir -> do

501− let nixEval = run nixInstantiatePath ["--eval", toTextIgnore (thunkDir </> ("thunk.nix" :: FilePath))]

502500 liftIO $ mkFiles thunkDir

503501 run_ "ob" ["thunk", "unpack", toTextIgnore thunkDir]

504− unpackedEval <- nixEval

505502 run_ "ob" ["thunk", "pack", toTextIgnore thunkDir]

506− packedEval <- nixEval

507− liftIO $ assertBool "Unpacked and packed thunk.nix should not eval to the same thing" $

508− unpackedEval /= packedEval

509503

510504data GitThunkParams = GitThunkParams

511505 { _gitThunkParams_repo :: !FilePath

@@ -605,4 +599,4 @@ legacyGitThunks (GitThunkParams repo' rev sha256) =

605599 LBS.writeFile (dir </> ("git.json" :: FilePath)) (Aeson.encode gitJson)

606600

607601unpackedDirName :: FilePath

608−unpackedDirName = "local"

602+unpackedDirName = "."