Allow to check ghcup binaries in validate-tarballs
This commit is contained in:
		
							parent
							
								
									c5858be6b8
								
							
						
					
					
						commit
						0c6699c3c6
					
				| @ -37,7 +37,7 @@ import           Data.IORef | ||||
| import           Data.List | ||||
| import           Data.String.Interpolate | ||||
| import           Data.Versions | ||||
| import           HPath                          ( toFilePath ) | ||||
| import           HPath                          ( toFilePath, rel ) | ||||
| import           Haskus.Utils.Variant.Excepts | ||||
| import           Optics | ||||
| import           System.Exit | ||||
| @ -202,6 +202,7 @@ validateTarballs (TarballFilter tool versionRegex) dls = do | ||||
|           %& indices (matchTest versionRegex . T.unpack . prettyVer) | ||||
|           % (viSourceDL % _Just `summing` viArch % each % each % each) | ||||
|     when (null dlis) $ $(logError) [i|no tarballs selected by filter|] *> addError | ||||
| 
 | ||||
|     forM_ dlis downloadAll | ||||
| 
 | ||||
|     -- exit | ||||
| @ -235,13 +236,21 @@ validateTarballs (TarballFilter tool versionRegex) dls = do | ||||
| #endif | ||||
|                ] | ||||
|       $ do | ||||
|         p <- liftE $ downloadCached dli Nothing | ||||
|         fmap (head . splitDirectories . head) | ||||
|           . liftE | ||||
|           . getArchiveFiles | ||||
|           $ p | ||||
|         case tool of | ||||
|           Just GHCup -> do | ||||
|             let fn = [rel|ghcup|] | ||||
|             dir <- liftIO ghcupCacheDir | ||||
|             p <- liftE $ download dli dir (Just fn) | ||||
|             liftE $ checkDigest dli p | ||||
|             pure Nothing | ||||
|           _ -> do | ||||
|             p <- liftE $ downloadCached dli Nothing | ||||
|             fmap (Just . head . splitDirectories . head) | ||||
|               . liftE | ||||
|               . getArchiveFiles | ||||
|               $ p | ||||
|     case r of | ||||
|       VRight basePath -> do | ||||
|       VRight (Just basePath) -> do | ||||
|         case _dlSubdir dli of | ||||
|           Just (RealDir (toFilePath -> prel)) -> do | ||||
|             lift $ $(logInfo) | ||||
| @ -262,6 +271,7 @@ validateTarballs (TarballFilter tool versionRegex) dls = do | ||||
|                 [i|Subdir doesn't match: expected regex "#{regexString}", got "#{basePath}"|] | ||||
|               addError | ||||
|           Nothing -> pure () | ||||
|       VRight Nothing -> pure () | ||||
|       VLeft  e -> do | ||||
|         lift $ $(logError) | ||||
|           [i|Could not download (or verify hash) of #{dli}, Error was: #{e}|] | ||||
|  | ||||
| @ -16,6 +16,7 @@ Portability : POSIX | ||||
| module GHCup.Utils.Dirs | ||||
|   ( getDirs | ||||
|   , ghcupConfigFile | ||||
|   , ghcupCacheDir | ||||
|   , ghcupGHCBaseDir | ||||
|   , ghcupGHCDir | ||||
|   , mkGhcupTmpDir | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user