git.iko.soy/obelisk
on master help sign in
command: Handoff to obelisk from 'ob init' to pack .obelisk/impl thunk
commite56f3b1f99a5e6f09414ecfaf3b454a0b9a3b067 authorTom Smalley <tfsmalley@gmail.com> dateThu 16 Apr 2020, 19:10 (6 years ago) parent62c6053
2 files changed+49−12
compare with master
unifiedsplit
lib/command/src/Obelisk/Command/Project.hs+27−3 lib/command/src/Obelisk/Command/Thunk.hs+22−9
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+22−9
@@ -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
@@ -803,15 +808,7 @@ unpackThunk' noTrail thunkDir = checkThunkDirectory thunkDir *> readThunk thunkD
803808 ThunkSource_Git s' -> (s', NonEmpty.head gitThunkSpecs)
804809 withSpinner' ("Fetching thunk " <> T.pack thunkName)
805810 (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"]
811+ gitCloneForThunkUnpack gitSrc (_thunkRev_commit $ _thunkPtr_rev tptr) (tmpThunk </> unpackedDirName)
815812
816813 createThunk tmpThunk $ Left newSpec
817814
@@ -819,6 +816,22 @@ unpackThunk' noTrail thunkDir = checkThunkDirectory thunkDir *> readThunk thunkD
819816 removePathForcibly thunkDir
820817 renameDirectory tmpThunk thunkDir
821818
819+gitCloneForThunkUnpack
820+ :: MonadObelisk m
821+ => GitSource -- ^ Git source to use
822+ -> Ref hash -- ^ Commit hash to reset to
823+ -> FilePath -- ^ Directory to clone into
824+ -> m ()
825+gitCloneForThunkUnpack gitSrc commit dir = do
826+ let git = callProcessAndLogOutput (Notice, Notice) . gitProc dir
827+ git $ [ "clone" ]
828+ ++ ["--recursive" | _gitSource_fetchSubmodules gitSrc]
829+ ++ [ T.unpack $ gitUriToText $ _gitSource_url gitSrc ]
830+ ++ do branch <- maybeToList $ _gitSource_branch gitSrc
831+ [ "--branch", T.unpack $ untagName branch ]
832+ git ["reset", "--hard", Ref.toHexString commit]
833+ when (_gitSource_fetchSubmodules gitSrc) $
834+ git ["submodule", "update", "--recursive", "--init"]
822835
823836--TODO: add a rollback mode to pack to the original thunk
824837packThunk :: MonadObelisk m => ThunkPackConfig -> FilePath -> m ThunkPtr