git.iko.soy/obelisk
on master help sign in
Merge pull request #700 from obsidiansystems/ts-fix-init-unpack-bug

Fix init unpack bug

commitb0ecb340bd92a4a0a6866d7c526204a33e1bdb32 authorElliot Cameron <3noch@users.noreply.github.com> dateThu 16 Apr 2020, 14:49 (6 years ago) parent62c60539f01811
3 files changed+60−23
compare with master
unifiedsplit
lib/command/src/Obelisk/Command/Project.hs+27−3 lib/command/src/Obelisk/Command/Thunk.hs+28−20 lib/selftest/src/Obelisk/SelfTest.hs+5
lib/command/src/Obelisk/Command/Project.hs+27−3
@@ -93,16 +93,22 @@ initProject source force = withSystemTempDirectory "ob-init" $ \tmpDir -> do
9393 | otherwise -> failWith "ob init requires an empty directory. Use the flag --force to init anyway, potentially overwriting files."
9494 skeleton <- withSpinner "Setting up obelisk" $ do
9595 liftIO $ createDirectory obDir
96+ -- Clone the git source and repack it with the init source obelisk
97+ -- The purpose of this is to ensure we use the correct thunk spec.
98+ let cloneAndRepack src = do
99+ putLog Debug $ "Cloning obelisk into " <> T.pack implDir <> " and repacking using itself"
100+ commit <- getLatestRev src
101+ gitCloneForThunkUnpack (thunkSourceToGitSource src) (_thunkRev_commit commit) implDir
102+ callHandoffOb implDir ["thunk", "pack", implDir]
96103 case source of
97− InitSource_Default -> createThunkWithLatest implDir obeliskSource
98− InitSource_Branch branch -> createThunkWithLatest implDir $ obeliskSourceWithBranch branch
104+ InitSource_Default -> cloneAndRepack obeliskSource
105+ InitSource_Branch branch -> cloneAndRepack $ obeliskSourceWithBranch branch
99106 InitSource_Symlink path -> do
100107 let symlinkPath = if isAbsolute path
101108 then path
102109 else ".." </> path
103110 liftIO $ createSymbolicLink symlinkPath implDir
104111 _ <- nixBuildAttrWithCache implDir "command"
105− --TODO: We should probably handoff to the impl here
106112 skel <- nixBuildAttrWithCache implDir "skeleton" --TODO: I don't think there's actually any reason to cache this
107113
108114 callProcessAndLogOutput (Notice, Error) $
@@ -128,6 +134,24 @@ initProject source force = withSystemTempDirectory "ob-init" $ \tmpDir -> do
128134 createDirectoryIfMissing False configDir
129135 mapM_ (createDirectoryIfMissing False . (configDir </>)) ["backend", "common", "frontend"]
130136
137+callHandoffOb
138+ :: MonadObelisk m
139+ => FilePath -- ^ Directory of the obelisk we want to handoff to
140+ -> [String] -- ^ Arguments to pass to ob
141+ -> m ()
142+callHandoffOb dir args = do
143+ obeliskCommandPkg <- nixCmd $ NixCmd_Build $ def
144+ & nixBuildConfig_outLink .~ OutLink_None
145+ & nixCmdConfig_target .~ Target
146+ { _target_path = Just dir
147+ , _target_attr = Just "command"
148+ , _target_expr = Nothing
149+ }
150+ let impl = obeliskCommandPkg </> "bin" </> "ob"
151+ -- Invoke the real implementation, using --no-handoff to prevent infinite recursion
152+ putLog Debug $ "Running '" <> T.pack (unwords args) <> "' with " <> T.pack impl
153+ callProcessAndLogOutput (Debug, Warning) (proc impl ("--no-handoff" : args))
154+
131155--TODO: Allow the user to ignore our security concerns
132156-- | Find the Obelisk implementation for the project at the given path
133157findProjectObeliskCommand :: MonadObelisk m => FilePath -> m (Maybe FilePath)
lib/command/src/Obelisk/Command/Thunk.hs+28−20
@@ -93,6 +93,11 @@ data ThunkSource
9393 | ThunkSource_Git GitSource
9494 deriving (Show, Eq, Ord)
9595
96+thunkSourceToGitSource :: ThunkSource -> GitSource
97+thunkSourceToGitSource = \case
98+ ThunkSource_GitHub s -> forgetGithub False s
99+ ThunkSource_Git s -> s
100+
96101data GitHubSource = GitHubSource
97102 { _gitHubSource_owner :: Name Owner
98103 , _gitHubSource_repo :: Name Repo
@@ -463,11 +468,7 @@ updateThunkToLatest (ThunkUpdateConfig mBranch thunkConfig) target = spinner $ d
463468 Just branch -> readThunk target >>= \case
464469 Left err -> failWith [i|Thunk update: ${err}|]
465470 Right c -> case c of
466− ThunkData_Packed _ t -> case _thunkPtr_source t of
467− ThunkSource_Git tsg -> setThunk thunkConfig target tsg branch
468− ThunkSource_GitHub tsgh -> do
469− let tsg = forgetGithub False tsgh
470− setThunk thunkConfig target tsg branch
471+ ThunkData_Packed _ t -> setThunk thunkConfig target (thunkSourceToGitSource $ _thunkPtr_source t) branch
471472 ThunkData_Checkout -> failWith [i|Thunk located at ${target} is unpacked. Use 'ob thunk pack' on the desired directory and then try 'ob thunk update' again.|]
472473 where
473474 spinner = withSpinner' ("Updating thunk " <> T.pack target <> " to latest") (pure $ const $ "Thunk " <> T.pack target <> " updated to latest")
@@ -798,20 +799,13 @@ unpackThunk' noTrail thunkDir = checkThunkDirectory thunkDir *> readThunk thunkD
798799 let (thunkParent, thunkName) = splitFileName thunkDir
799800 withTempDirectory thunkParent thunkName $ \tmpThunk -> do
800801 let
801− (gitSrc, newSpec) = case _thunkPtr_source tptr of
802− ThunkSource_GitHub s' -> (forgetGithub False s', NonEmpty.head gitHubThunkSpecs)
803− ThunkSource_Git s' -> (s', NonEmpty.head gitThunkSpecs)
802+ gitSrc = thunkSourceToGitSource $ _thunkPtr_source tptr
803+ newSpec = case _thunkPtr_source tptr of
804+ ThunkSource_GitHub _ -> NonEmpty.head gitHubThunkSpecs
805+ ThunkSource_Git _ -> NonEmpty.head gitThunkSpecs
804806 withSpinner' ("Fetching thunk " <> T.pack thunkName)
805807 (finalMsg noTrail $ const $ "Fetched thunk " <> T.pack thunkName) $ do
806− let git = callProcessAndLogOutput (Notice, Notice) . gitProc (tmpThunk </> unpackedDirName)
807− git $ [ "clone" ]
808− ++ ["--recursive" | _gitSource_fetchSubmodules gitSrc]
809− ++ [ T.unpack $ gitUriToText $ _gitSource_url gitSrc ]
810− ++ do branch <- maybeToList $ _gitSource_branch gitSrc
811− [ "--branch", T.unpack $ untagName branch ]
812− git ["reset", "--hard", Ref.toHexString $ _thunkRev_commit $ _thunkPtr_rev tptr]
813− when (_gitSource_fetchSubmodules gitSrc) $
814− git ["submodule", "update", "--recursive", "--init"]
808+ gitCloneForThunkUnpack gitSrc (_thunkRev_commit $ _thunkPtr_rev tptr) (tmpThunk </> unpackedDirName)
815809
816810 createThunk tmpThunk $ Left newSpec
817811
@@ -819,6 +813,22 @@ unpackThunk' noTrail thunkDir = checkThunkDirectory thunkDir *> readThunk thunkD
819813 removePathForcibly thunkDir
820814 renameDirectory tmpThunk thunkDir
821815
816+gitCloneForThunkUnpack
817+ :: MonadObelisk m
818+ => GitSource -- ^ Git source to use
819+ -> Ref hash -- ^ Commit hash to reset to
820+ -> FilePath -- ^ Directory to clone into
821+ -> m ()
822+gitCloneForThunkUnpack gitSrc commit dir = do
823+ let git = callProcessAndLogOutput (Notice, Notice) . gitProc dir
824+ git $ [ "clone" ]
825+ ++ ["--recursive" | _gitSource_fetchSubmodules gitSrc]
826+ ++ [ T.unpack $ gitUriToText $ _gitSource_url gitSrc ]
827+ ++ do branch <- maybeToList $ _gitSource_branch gitSrc
828+ [ "--branch", T.unpack $ untagName branch ]
829+ git ["reset", "--hard", Ref.toHexString commit]
830+ when (_gitSource_fetchSubmodules gitSrc) $
831+ git ["submodule", "update", "--recursive", "--init"]
822832
823833--TODO: add a rollback mode to pack to the original thunk
824834packThunk :: MonadObelisk m => ThunkPackConfig -> FilePath -> m ThunkPtr
@@ -981,9 +991,7 @@ getThunkPtr gitCheckClean dir mPrivate = do
981991-- | Get the latest revision available from the given source
982992getLatestRev :: MonadObelisk m => ThunkSource -> m ThunkRev
983993getLatestRev os = do
984− let gitS = case os of
985− ThunkSource_GitHub s -> forgetGithub False s
986− ThunkSource_Git s -> s
994+ let gitS = thunkSourceToGitSource os
987995 (_, commit) <- gitGetCommitBranch (_gitSource_url gitS) (untagName <$> _gitSource_branch gitS)
988996 case os of
989997 ThunkSource_GitHub s -> githubThunkRev s commit
lib/selftest/src/Obelisk/SelfTest.hs+5
@@ -194,6 +194,11 @@ main' isVerbose httpManager obeliskRepoReadOnly = withInitCache $ \initCache ->
194194 configs <- getConfigs
195195 return (either (const Nothing) Just $ getConfigRoute configs) `shouldNotReturn` Nothing
196196
197+ it "can unpack and repack .obelisk/impl after init with master branch impl" $ inTmp $ \_ -> do
198+ runOb_ ["init", "--branch", "master"]
199+ runOb_ ["thunk", "unpack", ".obelisk/impl"]
200+ runOb_ ["thunk", "pack", ".obelisk/impl"]
201+
197202 -- These tests fail with "Could not find module 'Obelisk.Generated.Static'"
198203 -- when not run by 'nix-build --attr selftest'
199204 describe "ob run" $ {- NOT parallel $ -} do