on master help sign in
Fall back on regular git methods if github thunk won't pack
commitb02101edecb9ea79c6a68c60ce51f9bae00d2f80 authorJohn Ericson <John.Ericson@Obsidian.Systems> dateMon 15 Oct 2018, 19:37 (8 years ago) parent62482d5
1 file changed+22−4
lib/command/src/Obelisk/Command/Thunk.hs+22−4
lib/command/src/Obelisk/Command/Thunk.hs+22−4
@@ -725,19 +725,37 @@ getLatestRev os = do
725725 ThunkSource_GitHub s -> githubThunkRev s commit
726726 ThunkSource_Git s -> gitThunkRev s commit
727727
728+-- | Convert a URI to a thunk
729+--
730+-- If the URL is a github URL, we try to just download an archive for
731+-- performance. If that doesn't work (e.g. authentication issue), we fall back
732+-- on just doing things the normal way for git repos in general, and save it as
733+-- a regular git thunk.
728734uriThunkPtr :: MonadObelisk m => URI -> Maybe Text -> m ThunkPtr
729735uriThunkPtr uri mbranch = do
730736 (_, commit) <- gitGetCommitBranch uri mbranch
731− let src = uriToThunkSource uri mbranch
732− rev <- case src of
733− ThunkSource_GitHub s -> githubThunkRev s commit
734− ThunkSource_Git s -> gitThunkRev s commit
737+ (src, rev) <- case uriToThunkSource uri mbranch of
738+ ThunkSource_GitHub s -> do
739+ rev <- runExceptT $ githubThunkRev s commit
740+ case rev of
741+ Right r -> pure (ThunkSource_GitHub s, r)
742+ Left e -> do
743+ putLog Alert $ " \
744+\ Failed to fetch archive from GitHub. This is probably a private repo. \
745+\ Falling back on normal fetchgit. Original failure:\n\n" <> T.pack (show e)
746+ let s' = forgetGithub s
747+ (,) (ThunkSource_Git s') <$> gitThunkRev s' commit
748+ ThunkSource_Git s -> (,) (ThunkSource_Git s) <$> gitThunkRev s commit
735749 pure $ ThunkPtr
736750 { _thunkPtr_rev = rev
737751 , _thunkPtr_source = src
738752 }
739753
740754-- | N.B. Cannot infer all fields.
755+--
756+-- If the thunk is a GitHub thunk and fails, we do *not* fall back like with
757+-- `uriThunkPtr`. Unlike a plain URL, a thunk src explicitly states which method
758+-- should be employed, and so we respect that.
741759uriToThunkSource :: URI -> Maybe Text -> ThunkSource
742760uriToThunkSource u
743761 | Right uriAuth <- uriAuthority u