@@ -156,16 +156,6 @@ nixPrefetchGit uri rev fetchSubmodules =
156156 Nothing -> failWith $ "nix-prefetch-git: unrecognized output " <> out
157157 Just x -> pure x
158158
159−getLatestGitRev :: MonadObelisk m => GitSource -> m ThunkRev
160−getLatestGitRev s = do
161− (_, commit) <- gitGetCommitBranch (_gitSource_url s) (untagName <$> _gitSource_branch s)
162− sha <- nixPrefetchGit (_gitSource_url s) commit (_gitSource_fetchSubmodules s)
163− putLog Debug $ "Nix sha256 is " <> sha
164− pure $ ThunkRev
165− { _thunkRev_commit = Ref.fromHexString $ T.unpack commit
166− , _thunkRev_nixSha256 = sha
167− }
168−
169159-- | Get the latest revision available from the given source
170160getLatestRev :: MonadObelisk m => ThunkSource -> m ThunkRev
171161getLatestRev = \case
@@ -189,7 +179,9 @@ getLatestRev = \case
189179 { _thunkRev_commit = commitNameToRef commit
190180 , _thunkRev_nixSha256 = nixSha256
191181 }
192− ThunkSource_Git s -> getLatestGitRev s
182+ ThunkSource_Git s -> do
183+ (_, commit) <- gitGetCommitBranch (_gitSource_url s) (untagName <$> _gitSource_branch s)
184+ gitThunkPtr s commit
193185
194186--TODO: Pretty print these
195187data ReadThunkError
@@ -724,82 +716,75 @@ getThunkPtr' checkClean thunkDir upstream = do
724716 refs
725717 mCurrentUpstreamBranch = Map.lookup currentHead remoteHeads
726718 <|> Map.lookup currentHead localHeads
727− f <- case isGithubThunk remoteUri of
728− Just (owner, repo) -> githubThunkPtr owner repo currentHead
729− Nothing -> gitThunkPtr remoteUri currentHead
730− pure $ f mCurrentUpstreamBranch
719+ let src = uriToThunkSource remoteUri mCurrentUpstreamBranch
720+ rev <- case src of
721+ ThunkSource_GitHub s -> githubThunkPtr s currentHead
722+ ThunkSource_Git s -> gitThunkPtr s currentHead
723+ pure $ ThunkPtr
724+ { _thunkPtr_rev = rev
725+ , _thunkPtr_source = src
726+ }
731727 where
732728 refsToTuples [x, y] = (x, y)
733729 refsToTuples x = error $ "thunk pack: cannot parse ref " <> show x
734730
735−-- Just comes with "proof" with the decomposed URL.x
736−isGithubThunk :: URI -> Maybe (String, String)
737−isGithubThunk u
731+-- | N.B. Cannot infer all fields.
732+uriToThunkSource :: URI -> Maybe Text -> ThunkSource
733+uriToThunkSource u
738734 | Just uriAuth <- uriAuthority u
739735 , case uriScheme u of
740736 "ssh:" -> uriAuth == URIAuth "git@" "github.com" ""
741737 s -> s `L.elem` [ "git:", "https:", "http:" ] -- "http:" just redirects to "https:"
742738 && uriRegName uriAuth == "github.com"
743− , ["/", owner', repo'] <- splitDirectories (uriPath u)
744− = Just (owner', repo')
745− | otherwise = Nothing
739+ , ["/", owner, repo] <- splitDirectories (uriPath u)
740+ = \mbranch -> ThunkSource_GitHub $ GitHubSource
741+ { _gitHubSource_owner = N $ T.pack owner
742+ , _gitHubSource_repo = N $ T.pack repo
743+ , _gitHubSource_branch = N <$> mbranch
744+ }
745+
746+ | otherwise = \mbranch -> ThunkSource_Git $ GitSource
747+ { _gitSource_url = u
748+ , _gitSource_branch = N <$> mbranch
749+ , _gitSource_fetchSubmodules = False -- TODO: How do we determine if this should be true?
750+ }
746751
747752-- Funny signature indicates no effects depend on the optional branch name.
748753githubThunkPtr
749754 :: MonadObelisk m
750− => String
751− -> String
755+ => GitHubSource
752756 -> Text
753− -> m (Maybe Text -> ThunkPtr)
754−githubThunkPtr owner' repo' commit = do
755− let owner = N (T.pack owner')
756− repo = N (T.pack (dropExtension repo'))
757+ -> m ThunkRev
758+githubThunkPtr s commit = do
757759 mauth <- liftIO $ getHubAuth "github.com"
758760 archiveResult <- liftIO $ executeRequestMaybe mauth $
759− archiveForR owner repo ArchiveFormatTarball (Just commit)
761+ archiveForR (_gitHubSource_owner s) (_gitHubSource_repo s) ArchiveFormatTarball (Just commit)
760762 archiveUri <- either (liftIO . throwIO) return archiveResult
761763 hash <- getNixSha256ForUriUnpacked archiveUri
762− return $ \mbranch -> ThunkPtr
763− { _thunkPtr_rev = ThunkRev
764− { _thunkRev_commit = commitNameToRef $ N commit
765− , _thunkRev_nixSha256 = hash
766− }
767− , _thunkPtr_source = ThunkSource_GitHub $ GitHubSource
768− { _gitHubSource_owner = owner
769− , _gitHubSource_repo = repo
770− , _gitHubSource_branch = N <$> mbranch
771− }
764+ putLog Debug $ "Nix sha256 is " <> hash
765+ return $ ThunkRev
766+ { _thunkRev_commit = commitNameToRef $ N commit
767+ , _thunkRev_nixSha256 = hash
772768 }
773769
774770gitThunkPtr
775771 :: MonadObelisk m
776− => URI
772+ => GitSource
777773 -> Text
778− -> m (Maybe Text -> ThunkPtr)
779−gitThunkPtr u commit = do
780− let protocols = ["https:", "ssh:", "git:"]
774+ -> m ThunkRev
775+gitThunkPtr s commit = do
776+ let u = _gitSource_url s
777+ protocols = ["https:", "ssh:", "git:"]
781778 unless (T.toLower (T.pack $ uriScheme u) `elem` protocols) $
782− failWith $ "thunk pack: obelisk currently only supports "
779+ failWith $ "obelisk currently only supports "
783780 <> T.intercalate ", " protocols <> " protocols for non-GitHub remotes"
784− hash <- nixPrefetchGit u commit False
785− pure $ \mbranch -> ThunkPtr
786− { _thunkPtr_rev = ThunkRev
787− { _thunkRev_commit = commitNameToRef (N commit)
788− , _thunkRev_nixSha256 = hash
789− }
790− , _thunkPtr_source = ThunkSource_Git $ GitSource
791− { _gitSource_url = u
792− , _gitSource_branch = N <$> mbranch
793− , _gitSource_fetchSubmodules = False -- TODO: How do we determine if this should be true?
794− }
781+ hash <- nixPrefetchGit u commit $ _gitSource_fetchSubmodules s
782+ putLog Debug $ "Nix sha256 is " <> hash
783+ pure $ ThunkRev
784+ { _thunkRev_commit = commitNameToRef (N commit)
785+ , _thunkRev_nixSha256 = hash
795786 }
796787
797−commitThunkPtr :: MonadObelisk m => URI -> Text -> m (Maybe Text -> ThunkPtr)
798−commitThunkPtr uri commit = do
799− case isGithubThunk uri of
800− Just (owner, repo) -> githubThunkPtr owner repo commit
801− Nothing -> gitThunkPtr uri commit
802−
803788gitGetCommitBranch
804789 :: MonadObelisk m => URI -> Maybe Text -> m (Text, Text)
805790gitGetCommitBranch uri mbranch = withExitFailMessage ("Failure for git remote " <> uriMsg) $ do
@@ -822,7 +807,14 @@ gitGetCommitBranch uri mbranch = withExitFailMessage ("Failure for git remote "
822807uriThunkPtr :: MonadObelisk m => URI -> Maybe Text -> m ThunkPtr
823808uriThunkPtr uri mbranch = do
824809 (_, commit) <- gitGetCommitBranch uri mbranch
825− commitThunkPtr uri commit <*> pure mbranch
810+ let src = uriToThunkSource uri mbranch
811+ rev <- case src of
812+ ThunkSource_GitHub s -> githubThunkPtr s commit
813+ ThunkSource_Git s -> gitThunkPtr s commit
814+ pure $ ThunkPtr
815+ { _thunkPtr_rev = rev
816+ , _thunkPtr_source = src
817+ }
826818
827819parseGitUri :: Text -> Maybe URI
828820parseGitUri x = parseURIReference (T.unpack x) <|> parseSshShorthand x