From 05322ee7495220d6d81732f5a2f3f7b15546052e Mon Sep 17 00:00:00 2001 From: dmjio Date: Thu, 22 Oct 2026 12:54:25 -0700 Subject: [PATCH] Downloads, clones and unpacked packages: complete, or not there at all The caches in $MISO_HOME/src were filled in place, and a folder that was there was taken as complete: - a git dependency was cloned and then checked out in its folder; a clone cut short, or a checkout that failed, left a folder at another commit, which later builds used without a word - a Hackage tarball was downloaded to its final name; one cut short was taken as the whole tarball (and a package not locked yet got the sha256 of the partial file in miso.lock) - a tarball was unpacked into src/hackage; an unpacking cut short left half a package - the clone that resolves short commits had the same problem Each is now written next to its final name and renamed when complete (as miso vendor and the package store already do): cloneAt and unpackHackage in Miso.CLI.Lock, and a .part file for downloads. A git checkout that is there is also checked to be at its commit, and cloned again when it is not. Checked with a test program against a local repository and tarballs: a checkout at a commit; one moved to another commit is cloned again; a checkout of a rev that does not exist, and a broken tarball, leave no folder. --- src/Miso/CLI/Deps.hs | 15 ++------- src/Miso/CLI/Lock.hs | 73 ++++++++++++++++++++++++++++++++++------- src/Miso/CLI/Resolve.hs | 3 +- 3 files changed, 67 insertions(+), 24 deletions(-) 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