@@ -32,7 +32,7 @@ module Obelisk.Command.Thunk
3232 ) where
3333
3434import Control.Applicative
35−import Control.Exception (displayException, throwIO, try)
35+import Control.Exception (displayException, try)
3636import Control.Lens.Indexed hiding ((<.>))
3737import Control.Monad
3838import Control.Monad.Catch (handle)
@@ -44,7 +44,6 @@ import qualified Data.Aeson.Types as Aeson
4444import qualified Data.ByteString.Lazy as LBS
4545import Data.Default
4646import Data.Either.Combinators (fromRight', rightToMaybe)
47−import Data.Foldable
4847import Data.Git.Ref (Ref)
4948import qualified Data.Git.Ref as Ref
5049import qualified Data.List as L
@@ -60,8 +59,7 @@ import qualified Data.Text as T
6059import Data.Text.Encoding
6160import qualified Data.Text.IO as T
6261import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
63−import Data.Yaml (parseMaybe, (.:))
64−import qualified Data.Yaml as Yaml
62+import Data.Yaml (parseMaybe)
6563import GitHub
6664import GitHub.Data.Name
6765import Obelisk.Command.Nix
@@ -465,20 +463,6 @@ plainGitStandaloneLoaderV2 = T.unlines
465463thunkFileNames :: [FilePath]
466464thunkFileNames = ["default.nix", "github.json", "git.json"]
467465
468−-- | Look for authentication info from the 'hub' command
469−getHubAuth
470− :: Text -- ^ Domain name
471− -> IO (Maybe Auth)
472−getHubAuth domain = do
473− hubConfig <- getXdgDirectory XdgConfig "hub"
474− Yaml.decodeFileEither hubConfig >>= \case
475− Left _ -> return Nothing
476− Right v -> return $ flip parseMaybe v $ \v' -> do
477− Yaml.Array domainConfigs <- v' .: domain --TODO: Determine what multiple domainConfigs means
478− [Yaml.Object domainConfig] <- return $ toList domainConfigs
479− token <- domainConfig .: "oauth_token"
480− return $ OAuth $ encodeUtf8 token
481−
482466--TODO: when checking something out, make a shallow clone
483467
484468-- | Checks a cache directory to see if there is a fresh symlink
@@ -587,41 +571,10 @@ unpackThunk' noTrail thunkDir = readThunk thunkDir >>= \case
587571 Right (ThunkData_Packed tptr) -> do
588572 let (thunkParent, thunkName) = splitFileName thunkDir
589573 withTempDirectory thunkParent thunkName $ \tmpRepo -> do
590− let obGitDir = tmpRepo </> ".git" </> "obelisk"
591− case _thunkPtr_source tptr of
592− ThunkSource_GitHub s -> do
593− mauth <- liftIO $ getHubAuth "github.com"
594− repoResult <- liftIO $ executeRequestMaybe mauth $ repositoryR (_gitHubSource_owner s) (_gitHubSource_repo s)
595− githubURI <- either (liftIO . throwIO) (return . repoSshUrl) repoResult >>= \case
596− Nothing -> failWith "Cannot determine clone URI for thunk source"
597− Just c -> return $ T.unpack $ getUrl c
598−
599− withSpinner' ("Fetching thunk " <> T.pack thunkDir)
600− (finalMsg noTrail $ const $ "Fetched thunk " <> T.pack thunkDir) $ do
601− callProcessAndLogOutput (Debug, Debug) $
602− proc "hub" ["clone", "-n", githubURI, tmpRepo]
603− --If this directory already exists then something is weird and we should fail
604− liftIO $ createDirectory obGitDir
605− callProcessAndLogOutput (Debug, Error) $
606− proc "cp" ["-r", "-T", thunkDir </> ".", obGitDir </> "orig-thunk"]
607−
608− -- Checkout
609− putLog Debug $ "Checking out " <> T.pack (show $ maybe "" untagName $ _gitHubSource_branch s)
610− callProcessAndLogOutput (Debug, Debug) $
611− proc "hub" $ concat
612− [ ["-C", tmpRepo]
613− , pure "checkout"
614− , maybe [] (\n -> ["-B", T.unpack (untagName n)]) (_gitHubSource_branch s)
615− , pure $ Ref.toHexString $ _thunkRev_commit $ _thunkPtr_rev tptr
616− ]
617− -- Set upstream branch
618− forM_ (_gitHubSource_branch s) $ \branch ->
619− callProcessAndLogOutput (Debug, Error) $
620− proc "hub" ["-C", tmpRepo, "branch", "-u", "origin/" <> T.unpack (untagName branch)]
621− callProcessAndLogOutput (Notice, Error) $ proc "rm" ["-r", thunkDir]
622− callProcessAndLogOutput (Notice, Error) $ proc "mv" ["-T", tmpRepo, thunkDir]
623−
624− ThunkSource_Git s -> do
574+ let obGitDir = tmpRepo </> ".git" </> "obelisk"
575+ s = case _thunkPtr_source tptr of
576+ ThunkSource_GitHub s' -> forgetGithub s'
577+ ThunkSource_Git s' -> s'
625578 withSpinner' ("Fetching thunk " <> T.pack thunkName)
626579 (finalMsg noTrail $ const $ "Fetched thunk " <> T.pack thunkName) $ do
627580 let git = callProcessAndLogOutput (Notice, Notice) . gitProc tmpRepo