@@ -40,7 +40,6 @@ import Data.Aeson ((.=))
4040import qualified Data.Aeson as Aeson
4141import Data.Aeson.Encode.Pretty
4242import qualified Data.Aeson.Types as Aeson
43−import Data.Bifunctor
4443import qualified Data.ByteString.Lazy as LBS
4544import Data.Default
4645import Data.Either.Combinators (rightToMaybe)
@@ -120,7 +119,7 @@ data GitHubSource = GitHubSource
120119
121120data GitSource = GitSource
122121 { _gitSource_url :: URI
123− , _gitSource_branch :: Name Branch
122+ , _gitSource_branch :: Maybe (Name Branch)
124123 , _gitSource_fetchSubmodules :: Bool
125124 }
126125 deriving (Show, Eq, Ord)
@@ -128,7 +127,7 @@ data GitSource = GitSource
128127getThunkGitBranch :: ThunkPtr -> Maybe Text
129128getThunkGitBranch (ThunkPtr _ src) = fmap untagName $ case src of
130129 ThunkSource_GitHub s -> _gitHubSource_branch s
131− ThunkSource_Git s -> Just $ _gitSource_branch s
130+ ThunkSource_Git s -> _gitSource_branch s
132131
133132commitNameToRef :: Name Commit -> Ref
134133commitNameToRef (N c) = Ref.fromHex $ encodeUtf8 c
@@ -159,29 +158,14 @@ nixPrefetchGit uri rev fetchSubmodules =
159158 Just x -> pure x
160159
161160getLatestGitRev :: MonadObelisk m => GitSource -> m ThunkRev
162−getLatestGitRev s = withSystemTempDirectory "git-clone" $ \tmpDir -> do
163− withExitFailMessage ("Unable to determine latest git revision for branch " <> branch) $ do
164− let git = readProcessAndLogStderr Debug . gitProc tmpDir
165− out <- liftA2 (<>)
166− (git ["clone", "--no-checkout", show $ _gitSource_url s]) -- Might be able to use --bare here instead to go faster.
167− (git ["log", T.unpack branch, "--max-count=1", "--format=%H"])
168−
169− case T.strip <$> safeLast (T.lines out) of
170− Nothing -> failWith $ "Unable to parse git log: " <> out
171− Just rev -> do
172− putLog Debug $ "Latest commit in " <> branch <> " is " <> rev
173− sha <- nixPrefetchGit (_gitSource_url s) rev (_gitSource_fetchSubmodules s)
174− putLog Debug $ "Nix sha256 is " <> sha
175− pure $ ThunkRev
176− { _thunkRev_commit = Ref.fromHexString $ T.unpack rev
177− , _thunkRev_nixSha256 = sha
178− }
179− where
180− remote :: Text = "origin"
181− branch :: Text = remote <> "/" <> untagName (_gitSource_branch s)
182−
183− safeLast [] = Nothing
184− safeLast xs = Just $ last xs
161+getLatestGitRev s = do
162+ (_, commit) <- gitGetCommitBranch (_gitSource_url s) (untagName <$> _gitSource_branch s)
163+ sha <- nixPrefetchGit (_gitSource_url s) commit (_gitSource_fetchSubmodules s)
164+ putLog Debug $ "Nix sha256 is " <> sha
165+ pure $ ThunkRev
166+ { _thunkRev_commit = Ref.fromHexString $ T.unpack commit
167+ , _thunkRev_nixSha256 = sha
168+ }
185169
186170-- | Get the latest revision available from the given source
187171getLatestRev :: MonadObelisk m => ThunkSource -> m ThunkRev
@@ -327,7 +311,7 @@ parseGitHubSource v = do
327311parseGitSource :: Aeson.Object -> Aeson.Parser GitSource
328312parseGitSource v = do
329313 Just url <- parseGitUri <$> v Aeson..: "url"
330− branch <- v Aeson..: "branch"
314+ branch <- v Aeson..:! "branch"
331315 fetchSubmodules <- v Aeson..:! "fetchSubmodules"
332316 pure $ GitSource
333317 { _gitSource_url = url
@@ -356,9 +340,7 @@ encodeThunkPtrData (ThunkPtr rev src) = case src of
356340 ThunkSource_GitHub s -> encodePretty' githubCfg $ Aeson.object $ catMaybes
357341 [ Just $ "owner" .= _gitHubSource_owner s
358342 , Just $ "repo" .= _gitHubSource_repo s
359− , case _gitHubSource_branch s of
360− Just b -> Just $ "branch" .= b
361− Nothing -> Nothing
343+ , ("branch" .=) <$> _gitHubSource_branch s
362344 , if _gitHubSource_private s
363345 then Just $ "private" .= True
364346 else Nothing
@@ -369,7 +351,7 @@ encodeThunkPtrData (ThunkPtr rev src) = case src of
369351 --TODO: Is this safe? read/show is jank for `URI`
370352 [ Just $ "url" .= show (_gitSource_url s)
371353 , Just $ "rev" .= Ref.toHexString (_thunkRev_commit rev)
372− , Just $ "branch" .= _gitSource_branch s
354+ , ("branch" .=) <$> _gitSource_branch s
373355 , Just $ "sha256" .= _thunkRev_nixSha256 rev
374356 , Just $ "fetchSubmodules" .= _gitSource_fetchSubmodules s
375357 ]
@@ -665,7 +647,9 @@ unpackThunk' noTrail thunkDir = readThunk thunkDir >>= \case
665647 git ["reset", "--hard", Ref.toHexString $ _thunkRev_commit $ _thunkPtr_rev tptr]
666648 when (_gitSource_fetchSubmodules s) $
667649 git ["submodule", "update", "--recursive", "--init"]
668− git ["branch", "-u", "origin/" <> T.unpack (untagName $ _gitSource_branch s)]
650+ case _gitSource_branch s of
651+ Just b -> git ["branch", "-u", "origin/" <> T.unpack (untagName $ b)]
652+ Nothing -> pure ()
669653
670654 liftIO $ createDirectory obGitDir
671655 callProcessAndLogOutput (Notice, Error) $
@@ -746,13 +730,10 @@ getThunkPtr' checkClean thunkDir upstream = do
746730 refs
747731 mCurrentUpstreamBranch = Map.lookup currentHead remoteHeads
748732 <|> Map.lookup currentHead localHeads
749− case isGithubThunk remoteUri of
750− Just (owner, repo) -> githubThunkPtr owner repo currentHead mCurrentUpstreamBranch
751− Nothing -> do
752− currentUpstreamBranch <- case mCurrentUpstreamBranch of
753− Just b -> pure b
754− Nothing -> failWith "Need explicit branch for git remote"
755− gitThunkPtr remoteUri currentHead currentUpstreamBranch
733+ f <- case isGithubThunk remoteUri of
734+ Just (owner, repo) -> githubThunkPtr owner repo currentHead
735+ Nothing -> gitThunkPtr remoteUri currentHead
736+ pure $ f mCurrentUpstreamBranch
756737 where
757738 refsToTuples [x, y] = (x, y)
758739 refsToTuples x = error $ "thunk pack: cannot parse ref " <> show x
@@ -769,64 +750,88 @@ isGithubThunk u
769750 = Just (owner', repo')
770751 | otherwise = Nothing
771752
772−githubThunkPtr :: MonadObelisk m => String -> String -> Text -> Maybe Text -> m ThunkPtr
773−githubThunkPtr owner' repo' commit' branch' = do
753+-- Funny signature indicates no effects depend on the optional branch name.
754+githubThunkPtr
755+ :: MonadObelisk m
756+ => String
757+ -> String
758+ -> Text
759+ -> m (Maybe Text -> ThunkPtr)
760+githubThunkPtr owner' repo' commit = do
774761 let owner = N (T.pack owner')
775762 repo = N (T.pack (dropExtension repo'))
776− commit = N commit'
777− branch = N <$> branch'
778763 mauth <- liftIO $ getHubAuth "github.com"
779764 repoResult <- liftIO $ executeRequestMaybe mauth $ repositoryR owner repo
780765 repoIsPrivate <- either (liftIO . throwIO) (return . repoPrivate) repoResult
781766 archiveResult <- liftIO $ executeRequestMaybe mauth $
782− archiveForR owner repo ArchiveFormatTarball (Just (untagName commit))
767+ archiveForR owner repo ArchiveFormatTarball (Just commit)
783768 archiveUri <- either (liftIO . throwIO) return archiveResult
784769 hash <- getNixSha256ForUriUnpacked archiveUri
785− return $ ThunkPtr
770+ return $ \mbranch -> ThunkPtr
786771 { _thunkPtr_rev = ThunkRev
787− { _thunkRev_commit = commitNameToRef commit
772+ { _thunkRev_commit = commitNameToRef $ N commit
788773 , _thunkRev_nixSha256 = hash
789774 }
790775 , _thunkPtr_source = ThunkSource_GitHub $ GitHubSource
791776 { _gitHubSource_owner = owner
792777 , _gitHubSource_repo = repo
793− , _gitHubSource_branch = branch
778+ , _gitHubSource_branch = N <$> mbranch
794779 , _gitHubSource_private = repoIsPrivate
795780 }
796781 }
797782
798−gitThunkPtr :: MonadObelisk m => URI -> Text -> Text -> m ThunkPtr
799−gitThunkPtr u commit branch = do
783+gitThunkPtr
784+ :: MonadObelisk m
785+ => URI
786+ -> Text
787+ -> m (Maybe Text -> ThunkPtr)
788+gitThunkPtr u commit = do
800789 let protocols = ["https:", "ssh:", "git:"]
801790 unless (T.toLower (T.pack $ uriScheme u) `elem` protocols) $
802791 failWith $ "thunk pack: obelisk currently only supports "
803792 <> T.intercalate ", " protocols <> " protocols for non-GitHub remotes"
804793 hash <- nixPrefetchGit u commit False
805− pure $ ThunkPtr
794+ pure $ \mbranch -> ThunkPtr
806795 { _thunkPtr_rev = ThunkRev
807796 { _thunkRev_commit = commitNameToRef (N commit)
808797 , _thunkRev_nixSha256 = hash
809798 }
810799 , _thunkPtr_source = ThunkSource_Git $ GitSource
811800 { _gitSource_url = u
812− , _gitSource_branch = N branch
801+ , _gitSource_branch = N <$> mbranch
813802 , _gitSource_fetchSubmodules = False -- TODO: How do we determine if this should be true?
814803 }
815804 }
816805
817−uriThunkPtr :: MonadObelisk m => URI -> Maybe Text -> m ThunkPtr
818−uriThunkPtr uri mbranch = do
806+commitThunkPtr :: MonadObelisk m => URI -> Text -> m (Maybe Text -> ThunkPtr)
807+commitThunkPtr uri commit = do
808+ case isGithubThunk uri of
809+ Just (owner, repo) -> githubThunkPtr owner repo commit
810+ Nothing -> gitThunkPtr uri commit
811+
812+gitGetCommitBranch
813+ :: MonadObelisk m => URI -> Maybe Text -> m (Text, Text)
814+gitGetCommitBranch uri mbranch = withExitFailMessage ("Failure for git remote " <> uriMsg) $ do
819815 bothMaps <- rethrowE =<< liftIO (gitLsRemote (show uri) (GitRef_Branch <$> mbranch))
820− branch <- rethrowE $ first (("In repo from " <> T.pack (show uri) <> ": ") <>) $
821− case mbranch of
822− Nothing -> gitLookupDefaultBranch bothMaps
823− Just b -> pure b
816+ branch <- case mbranch of
817+ Nothing -> withExitFailMessage "Failed to find default branch" $ do
818+ b <- rethrowE $ gitLookupDefaultBranch bothMaps
819+ putLog Debug $ "Default branch for remote repo " <> uriMsg <> " is " <> b
820+ pure b
821+ Just b -> pure b
824822 commit <- rethrowE $ gitLookupCommitForRef bothMaps (GitRef_Branch branch)
825− case isGithubThunk uri of
826− Just (owner, repo) -> githubThunkPtr owner repo commit mbranch
827− Nothing -> gitThunkPtr uri commit branch
823+ putLog Debug $ "Latest commit in branch " <> branch
824+ <> " from remote repo " <> uriMsg
825+ <> " is " <> commit
826+ pure (branch, commit)
828827 where
829828 rethrowE = either failWith pure
829+ uriMsg = T.pack $ show uri
830+
831+uriThunkPtr :: MonadObelisk m => URI -> Maybe Text -> m ThunkPtr
832+uriThunkPtr uri mbranch = do
833+ (_, commit) <- gitGetCommitBranch uri mbranch
834+ commitThunkPtr uri commit <*> pure mbranch
830835
831836parseGitUri :: Text -> Maybe URI
832837parseGitUri x = parseURIReference (T.unpack x) <|> parseSshShorthand x