diff --git a/src/Miso/CLI/Deps.hs b/src/Miso/CLI/Deps.hs index 03f9c01..13eaa65 100644 --- a/src/Miso/CLI/Deps.hs +++ b/src/Miso/CLI/Deps.hs @@ -338,11 +338,8 @@ sourceOf vend d ml = dir <- vendoredDir vs ml d pure (Just dir, Just dir) (_, Just (LockedHackage n v h)) -> do - home <- misoHome tarball <- checkedTarball n v h - let dir = home ++ "/src/hackage/" ++ n ++ "-" ++ v - unpacked <- doesDirectoryExist dir - unless unpacked $ run ("tar -xzf " ++ quote tarball ++ " -C " ++ quote (home ++ "/src/hackage")) + dir <- unpackHackage tarball (n ++ "-" ++ v) pure (Just dir, Nothing) (_, Just (LockedGit n repo _ c _)) -> do dir <- checkoutAt n repo c @@ -355,18 +352,12 @@ sourceOf vend d ml = (Just repo, _, _) -> do dir <- gitDir d cloned <- doesDirectoryExist dir - unless cloned $ do - step ("cloning " ++ repo) - run ("git clone --quiet " ++ quote repo ++ " " ++ quote dir) - maybe (pure ()) (\r -> run ("git -C " ++ quote dir ++ " checkout --quiet " ++ quote r)) (depRev d) + unless cloned $ cloneAt repo (depRev d) dir pure (Just dir, Nothing) (_, _, Just v) -> do -- a version of miso.yml that the lock does not have yet - home <- misoHome tarball <- hackageTarball (depName d) v - let dir = home ++ "/src/hackage/" ++ depName d ++ "-" ++ v - unpacked <- doesDirectoryExist dir - unless unpacked $ run ("tar -xzf " ++ quote tarball ++ " -C " ++ quote (home ++ "/src/hackage")) + dir <- unpackHackage tarball (depName d ++ "-" ++ v) pure (Just dir, Nothing) _ -> pure (Nothing, Nothing) diff --git a/src/Miso/CLI/Lock.hs b/src/Miso/CLI/Lock.hs index c5e9db2..5821c63 100644 --- a/src/Miso/CLI/Lock.hs +++ b/src/Miso/CLI/Lock.hs @@ -39,12 +39,14 @@ module Miso.CLI.Lock , newestVersion , describeChanges , hackageTarball + , unpackHackage , sha256File , sha256Tree , gitCheckout + , cloneAt ) where -import Control.Monad (unless) +import Control.Monad (unless, when) import Data.Char (isDigit, isHexDigit, isSpace, toLower) import Data.List (isPrefixOf) import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist, listDirectory, removeFile) @@ -211,14 +213,34 @@ hackageTarball n v = do there <- doesFileExist file unless there $ do step ("downloading " ++ nv) - ok <- tryRun ("curl -fsSL -o " ++ quote file ++ " " - ++ quote ("https://hackage.haskell.org/package/" ++ nv ++ "/" ++ nv ++ ".tar.gz")) + -- to a .part file, renamed when it is complete: a download cut short + -- (Ctrl-C) leaves no tarball, which would be taken as the whole one + -- (and, for a package not locked yet, its sha256 locked) + let part = file ++ ".part" + ok <- tryRun ("curl -fsSL -o " ++ quote part ++ " " + ++ quote ("https://hackage.haskell.org/package/" ++ nv ++ "/" ++ nv ++ ".tar.gz") + ++ " && mv -f " ++ quote part ++ " " ++ quote file) unless ok $ do - gone <- not <$> doesFileExist file - unless gone (removeFile file) + _ <- tryRun ("rm -f " ++ quote part) failWith ("could not download " ++ nv ++ " from Hackage") pure file +-- | A Hackage tarball unpacked in $MISO_HOME/src/hackage/NAME-VERSION (once). +-- It is unpacked next to it and renamed when complete, so an unpacking cut +-- short leaves no half of a package to be built later. +unpackHackage :: FilePath -> String -> IO FilePath +unpackHackage tarball nv = do + home <- misoHome + let dir = home ++ "/src/hackage/" ++ nv + tmp = dir ++ ".tmp" + there <- doesDirectoryExist dir + unless there $ + run ("rm -rf " ++ quote tmp ++ " && mkdir -p " ++ quote tmp + ++ " && tar -xzf " ++ quote tarball ++ " -C " ++ quote tmp + ++ " && mv " ++ quote (tmp ++ "/" ++ nv) ++ " " ++ quote dir + ++ " && rm -rf " ++ quote tmp) + pure dir + -- | The sha256 of a file, with sha256sum (Linux, MSYS2) or shasum (macOS). sha256File :: FilePath -> IO String sha256File f = do @@ -274,17 +296,41 @@ tagVersion r = in if not (null v) && isDigit (head v) && all (\c -> isDigit c || c == '.') v then Just v else Nothing -- | A checkout of a git dependency at a commit, in $MISO_HOME/src (cloned --- once; miso install builds it there). +-- once; miso install builds it there). One that is there but not at the +-- commit (left by an older miso, cut short or moved by hand) is cloned +-- again, rather than built at the wrong commit. gitCheckout :: String -> String -> String -> IO FilePath gitCheckout n repo c = do home <- misoHome let dir = home ++ "/src/" ++ n ++ "-" ++ c cloned <- doesDirectoryExist dir - unless cloned $ do - step ("cloning " ++ repo) - run ("git clone --quiet " ++ quote repo ++ " " ++ quote dir) - run ("git -C " ++ quote dir ++ " checkout --quiet " ++ quote c) + ok <- if cloned then atCommit dir else pure False + unless ok $ do + when cloned $ do + warn (dir ++ " is not at " ++ c ++ ": cloning it again") + run ("rm -rf " ++ quote dir) + cloneAt repo (Just c) dir + at <- atCommit dir + unless at $ failWith ("the checkout of " ++ repo ++ " is not at " ++ c) pure dir + where + atCommit d = do + out <- readCommand ("git -C " ++ quote d ++ " rev-parse HEAD 2>/dev/null") + pure (maybe False (\h -> c `isPrefixOf` takeWhile isHexDigit h) out) + +-- | Clone a repository into dir, and check out a rev (a commit, tag or +-- branch). It is cloned next to dir and renamed when the checkout is done, +-- so a clone or checkout that fails or is cut short leaves no dir behind +-- (one would be taken as complete, at whatever commit it was). +cloneAt :: String -> Maybe String -> FilePath -> IO () +cloneAt repo mrev dir = do + let tmp = dir ++ ".tmp" + createDirectoryIfMissing True (parent dir) + step ("cloning " ++ repo) + run ("rm -rf " ++ quote tmp) + run ("git clone --quiet " ++ quote repo ++ " " ++ quote tmp) + maybe (pure ()) (\r -> run ("git -C " ++ quote tmp ++ " checkout --quiet " ++ quote r)) mrev + run ("mv " ++ quote tmp ++ " " ++ quote dir) -- | The version of the package in a directory: its miso.yml's, or (with -- none) its .cabal file's. @@ -333,7 +379,12 @@ expandCommit d repo short = do there <- doesDirectoryExist dir if there then run ("git -C " ++ quote dir ++ " fetch --quiet") - else run ("git clone --quiet --no-checkout " ++ quote repo ++ " " ++ quote dir) + else do + -- cloned next to it and renamed, so a clone cut short leaves nothing + let tmp = dir ++ ".tmp" + run ("rm -rf " ++ quote tmp) + run ("git clone --quiet --no-checkout " ++ quote repo ++ " " ++ quote tmp) + run ("mv " ++ quote tmp ++ " " ++ quote dir) out <- readCommand ("git -C " ++ quote dir ++ " rev-parse --verify --quiet " ++ quote (short ++ "^{commit}")) case fmap trim out of Just c | length c == 40 -> pure c diff --git a/src/Miso/CLI/Resolve.hs b/src/Miso/CLI/Resolve.hs index 9a6e106..5f4d829 100644 --- a/src/Miso/CLI/Resolve.hs +++ b/src/Miso/CLI/Resolve.hs @@ -228,7 +228,8 @@ resolveTree keep old cfg = do tarball <- hackageTarball n v h' <- sha256File tarball unless (h' == h) $ failWith (n ++ "-" ++ v ++ ": the sha256 of the tarball is " ++ h' ++ ", " ++ lockFile ++ " has " ++ h) - run ("tar -xzf " ++ quote tarball ++ " -C " ++ quote (home ++ "/src/hackage")) + _ <- unpackHackage tarball (n ++ "-" ++ v) + pure () packageDeps env (concatMap flagsOf (take 1 mroot)) (why chain) dir >>= mapM_ (visit (n : chain)) emit l -- a Hackage package: kept from miso.lock, or at the package list's