Don't clean up tmp dirs when --keep=always

.github/scripts/common.sh

@@ -87,39 +87,29 @@ download_cabal_cache() {
 	cd /tmp
 	case "${RUNNER_OS}" in
 		"Linux")
-			case "${DISTRO}" in
+			case "${ARCH}" in
-				"Alpine")
+				"32") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/i386-linux-cabal-cache
-					case "${ARCH}" in
-						"32") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/1.0.5.1/i386-linux-alpine-cabal-cache-1.0.5.1
-							;;
-						"64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/1.0.5.1/x86_64-linux-alpine-cabal-cache-1.0.5.1
-							;;
-					esac
 					;;
-				*)
+				"64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/x86_64-linux-cabal-cache
-					case "${ARCH}" in
+					;;
-						"64") url=https://github.com/haskell-works/cabal-cache/releases/download/v1.0.5.1/cabal-cache-x86_64-linux.gz
+				"ARM64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/aarch64-linux-cabal-cache
-							;;
+					;;
-						"ARM64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/1.0.5.1/aarch64-linux-cabal-cache-1.0.5.1
+				"ARM") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/armv7-linux-cabal-cache
-							;;
-						"ARM") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/1.0.5.1/armv7-linux-cabal-cache-1.0.5.1
-							;;
-					esac
 					;;
 			esac
 			;;
 		"FreeBSD")
-			url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/1.0.5.1/x86_64-freebsd-cabal-cache-1.0.5.1
+			url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/x86_64-portbld-freebsd-cabal-cache
 			;;
 		"Windows")
 			exe=".exe"
-			url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/1.0.5.1/x86_64-mingw64-cabal-cache-1.0.5.1.exe
+			url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/x86_64-mingw64-cabal-cache
 			;;
 		"macOS")
 			case "${ARCH}" in
-				"ARM64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/1.0.5.1/aarch64-apple-darwin-cabal-cache-1.0.5.1
+				"ARM64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/aarch64-apple-darwin-cabal-cache
 					;;
-				"64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/1.0.5.1/x86_64-apple-darwin-cabal-cache-1.0.5.1
+				"64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/x86_64-apple-darwin-cabal-cache
 					;;
 			esac
 			;;
@@ -134,8 +124,9 @@ download_cabal_cache() {
 				curl -o cabal-cache${exe} -L "${url}"
 				;;
 		esac
-		chmod +x cabal-cache${exe}
+		sha_sum cabal-cache${exe}
-		cp "cabal-cache${exe}" "${dest}${exe}"
+		mv "cabal-cache${exe}" "${dest}${exe}"
+		chmod +x "${dest}${exe}"
 	fi
     )
 }

.github/workflows/release.yaml

@@ -102,7 +102,7 @@ jobs:
       - uses: docker://arm64v8/ubuntu:focal
         name: Cleanup (aarch64 linux)
         with:
-          args: rm -rf .ghcup/ cabal/ dist-newstyle/ out/
+          args: "find . -mindepth 1 -maxdepth 1 -exec rm -rf -- {} +"
 
       - name: git config
         run: |
@@ -297,7 +297,7 @@ jobs:
       - uses: docker://arm64v8/ubuntu:focal
         name: Cleanup (aarch64 linux)
         with:
-          args: rm -rf .ghcup/ cabal/ dist-newstyle/ out/
+          args: "find . -mindepth 1 -maxdepth 1 -exec rm -rf -- {} +"
 
       - name: Checkout code
         uses: actions/checkout@v3
@@ -311,7 +311,7 @@ jobs:
 
       - if: matrix.ARCH == 'ARM'
         uses: docker://hasufell/arm32v7-ubuntu-haskell:focal
-        name: Run test (armv7 linux)
+        name: Run build (armv7 linux)
         with:
           args: sh .github/scripts/test.sh
         env:
@@ -322,7 +322,7 @@ jobs:
 
       - if: matrix.ARCH == 'ARM64'
         uses: docker://hasufell/arm64v8-ubuntu-haskell:focal
-        name: Run test (aarch64 linux)
+        name: Run build (aarch64 linux)
         with:
           args: sh .github/scripts/test.sh
         env:

app/ghcup/GHCup/OptParse.hs

@@ -67,13 +67,13 @@ import           URI.ByteString
 import qualified Data.ByteString.UTF8          as UTF8
 
 
+
 data Options = Options
   {
   -- global options
     optVerbose     :: Maybe Bool
   , optCache       :: Maybe Bool
   , optMetaCache   :: Maybe Integer
-  , optMetaMode    :: Maybe MetaMode
   , optPlatform    :: Maybe PlatformRequest
   , optUrlSource   :: Maybe URI
   , optNoVerify    :: Maybe Bool
@@ -116,8 +116,7 @@ opts =
   Options
     <$> invertableSwitch "verbose" (Just 'v') False (help "Enable verbosity (default: disabled)")
     <*> invertableSwitch "cache" (Just 'c') False (help "Cache downloads in ~/.ghcup/cache (default: disabled)")
-    <*> optional (option auto (long "metadata-caching" <> metavar "SEC" <> help "How long the yaml metadata caching interval is (in seconds), 0 to disable"))
+    <*> optional (option auto (long "metadata-caching" <> help "How long the yaml metadata caching interval is (in seconds), 0 to disable" <> internal))
-    <*> optional (option auto (long "metadata-fetching-mode" <> metavar "<Strict|Lax>" <> help "Whether to fail on metadata download failure (Strict) or fall back to cached version (Lax (default))"))
     <*> optional
       (option
         (eitherReader platformParser)

app/ghcup/GHCup/OptParse/Config.hs

@@ -59,7 +59,7 @@ data ConfigCommand
     --[ Parsers ]--
     ---------------
 
-
+          
 configP :: Parser ConfigCommand
 configP = subparser
       (  command "init" initP
@@ -124,7 +124,6 @@ updateSettings :: UserSettings -> Settings -> Settings
 updateSettings UserSettings{..} Settings{..} =
    let cache'      = fromMaybe cache uCache
        metaCache'  = fromMaybe metaCache uMetaCache
-       metaMode'   = fromMaybe metaMode uMetaMode
        noVerify'   = fromMaybe noVerify uNoVerify
        keepDirs'   = fromMaybe keepDirs uKeepDirs
        downloader' = fromMaybe downloader uDownloader
@@ -133,7 +132,7 @@ updateSettings UserSettings{..} Settings{..} =
        noNetwork'  = fromMaybe noNetwork uNoNetwork
        gpgSetting' = fromMaybe gpgSetting uGPGSetting
        platformOverride' = uPlatformOverride <|> platformOverride
-   in Settings cache' metaCache' metaMode' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor platformOverride'
+   in Settings cache' metaCache' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor platformOverride'
 
 
 

app/ghcup/Main.hs

@@ -79,7 +79,6 @@ toSettings options = do
    mergeConf Options{..} UserSettings{..} noColor =
      let cache       = fromMaybe (fromMaybe (Types.cache defaultSettings) uCache) optCache
          metaCache   = fromMaybe (fromMaybe (Types.metaCache defaultSettings) uMetaCache) optMetaCache
-         metaMode    = fromMaybe (fromMaybe (Types.metaMode defaultSettings) uMetaMode) optMetaMode
          noVerify    = fromMaybe (fromMaybe (Types.noVerify defaultSettings) uNoVerify) optNoVerify
          verbose     = fromMaybe (fromMaybe (Types.verbose defaultSettings) uVerbose) optVerbose
          keepDirs    = fromMaybe (fromMaybe (Types.keepDirs defaultSettings) uKeepDirs) optKeepDirs

data/config.yaml

@@ -40,12 +40,6 @@ key-bindings:
 # of the file. These usually are in '~/.ghcup/cache/ghcup-<ver>.yaml'.
 meta-cache: 300 # in seconds
 
-# When trying to download ghcup metadata, this option decides what to do
-# when the download fails:
-#   1. Lax: use existing ~/.ghcup/cache/ghcup-<ver>.yaml as fallback (default)
-#   2. Strict: fail hard
-meta-mode: Lax # Strict | Lax
-
 # Where to get GHC/cabal/hls download info/versions from. For more detailed explanation
 # check the 'URLSource' type in the code.
 url-source:

lib/GHCup/Download.hs

@@ -162,21 +162,17 @@ getBase :: ( MonadReader env m
            , MonadMask m
            )
         => URI
-        -> Excepts '[DownloadFailed, GPGError, DigestError, JSONError, FileDoesNotExistError] m GHCupInfo
+        -> Excepts '[GPGError, DigestError, JSONError, FileDoesNotExistError] m GHCupInfo
 getBase uri = do
-  Settings { noNetwork, downloader, metaMode } <- lift getSettings
+  Settings { noNetwork, downloader } <- lift getSettings
 
   -- try to download yaml... usually this writes it into cache dir,
   -- but in some cases not (e.g. when using file://), so we honour
   -- the return filepath, if any
   mYaml <- if noNetwork && view (uriSchemeL' % schemeBSL') uri /= "file" -- for file://, let it fall through
            then pure Nothing
-           else handleIO (\e -> case metaMode of
+           else handleIO (\e -> lift (warnCache (displayException e) downloader) >> pure Nothing)
-                                  Strict -> throwIO e
+               . catchE @_ @_ @'[] (\e@(DownloadFailed _) -> lift (warnCache (prettyShow e) downloader) >> pure Nothing)
-                                  Lax -> lift (warnCache (displayException e) downloader) >> pure Nothing)
-               . catchE @_ @_ @'[DownloadFailed] (\e@(DownloadFailed _) -> case metaMode of
-                   Strict -> throwE e
-                   Lax -> lift (warnCache (prettyShow e) downloader) >> pure Nothing)
                . fmap Just
                . smartDl
                $ uri

lib/GHCup/Types.hs

@@ -297,16 +297,10 @@ instance NFData URLSource
 instance NFData (URIRef Absolute) where
   rnf (URI !_ !_ !_ !_ !_) = ()
 
-data MetaMode = Strict
-              | Lax
-  deriving (Show, Read, Eq, GHC.Generic)
-
-instance NFData MetaMode
 
 data UserSettings = UserSettings
   { uCache       :: Maybe Bool
   , uMetaCache   :: Maybe Integer
-  , uMetaMode    :: Maybe MetaMode
   , uNoVerify    :: Maybe Bool
   , uVerbose     :: Maybe Bool
   , uKeepDirs    :: Maybe KeepDirs
@@ -320,14 +314,13 @@ data UserSettings = UserSettings
   deriving (Show, GHC.Generic)
 
 defaultUserSettings :: UserSettings
-defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
+defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
 
 fromSettings :: Settings -> Maybe KeyBindings -> UserSettings
 fromSettings Settings{..} Nothing =
   UserSettings {
       uCache = Just cache
     , uMetaCache = Just metaCache
-    , uMetaMode = Just metaMode
     , uNoVerify = Just noVerify
     , uVerbose = Just verbose
     , uKeepDirs = Just keepDirs
@@ -353,7 +346,6 @@ fromSettings Settings{..} (Just KeyBindings{..}) =
   in UserSettings {
       uCache = Just cache
     , uMetaCache = Just metaCache
-    , uMetaMode = Just metaMode
     , uNoVerify = Just noVerify
     , uVerbose = Just verbose
     , uKeepDirs = Just keepDirs
@@ -434,7 +426,6 @@ instance NFData LeanAppState
 data Settings = Settings
   { cache            :: Bool
   , metaCache        :: Integer
-  , metaMode         :: MetaMode
   , noVerify         :: Bool
   , keepDirs         :: KeepDirs
   , downloader       :: Downloader
@@ -451,7 +442,7 @@ defaultMetaCache :: Integer
 defaultMetaCache = 300 -- 5 minutes
 
 defaultSettings :: Settings
-defaultSettings = Settings False defaultMetaCache Lax False Never Curl False GHCupURL False GPGNone False Nothing
+defaultSettings = Settings False defaultMetaCache False Never Curl False GHCupURL False GPGNone False Nothing
 
 instance NFData Settings
 

lib/GHCup/Types/JSON.hs

@@ -43,7 +43,6 @@ import qualified Text.Megaparsec               as MP
 import qualified Text.Megaparsec.Char          as MPC
 
 
-deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''MetaMode
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Architecture
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''LinuxDistro
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VSep

lib/GHCup/Utils/Dirs.hs

@@ -465,15 +465,22 @@ withGHCupTmpDir :: ( MonadReader env m
                    , MonadMask m
                    , MonadIO m)
                 => m GHCupPath
-withGHCupTmpDir = snd <$> withRunInIO (\run ->
+withGHCupTmpDir = do
-  run
+  Settings{keepDirs} <- getSettings
-    $ allocate
+  snd <$> withRunInIO (\run ->
-        (run mkGhcupTmpDir)
+    run
-        (\fp ->
+      $ allocate
-            handleIO (\e -> run
+          (run mkGhcupTmpDir)
-                $ logDebug ("Resource cleanup failed for " <> T.pack (fromGHCupPath fp) <> ", error was: " <> T.pack (displayException e)))
+          (\fp -> if -- we don't know whether there was a failure, so can only
-            . removePathForcibly
+                     -- decide for 'Always'
-            $ fp))
+                     | keepDirs == Always -> pure ()
+                     | otherwise -> handleIO (\e -> run
+                        $ logDebug ("Resource cleanup failed for "
+                                   <> T.pack (fromGHCupPath fp)
+                                   <> ", error was: "
+                                   <> T.pack (displayException e)))
+                        . removePathForcibly
+                        $ fp))