Bump cabal-cache with amazonka patch

This should fix parsing issues in amazonka and
cabal-cache:

* https://github.com/haskell-works/cabal-cache/issues/207
* https://github.com/brendanhay/amazonka/issues/866

.cirrus.yml

@@ -17,6 +17,8 @@ task:
     S3_HOST: ENCRYPTED[ce961780a33159f7d1d8046956b5ac6ebc3bfc8149428e5f538576cda51d9f3d0c35b79cdd1e325793639ff6e31f889d]
   install_script: pkg install -y ghc hs-cabal-install git bash misc/compat10x misc/compat11x misc/compat12x gmake
   script:
+    - tzsetup Etc/GMT
+    - adjkerntz -a
     - bash .github/scripts/build.sh
     - bash .github/scripts/test.sh
   binaries_artifacts:

.github/scripts/common.sh

@@ -88,28 +88,28 @@ download_cabal_cache() {
 	case "${RUNNER_OS}" in
 		"Linux")
 			case "${ARCH}" in
-				"32") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/i386-linux-cabal-cache
+				"32") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental5/i386-linux-cabal-cache
 					;;
-				"64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/x86_64-linux-cabal-cache
+				"64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental5/x86_64-linux-cabal-cache
 					;;
-				"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/experimental5/aarch64-linux-cabal-cache
 					;;
-				"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/experimental5/armv7-linux-cabal-cache
 					;;
 			esac
 			;;
 		"FreeBSD")
-			url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/x86_64-portbld-freebsd-cabal-cache
+			url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental5/x86_64-portbld-freebsd-cabal-cache
 			;;
 		"Windows")
 			exe=".exe"
-			url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/x86_64-mingw64-cabal-cache
+			url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental5/x86_64-mingw64-cabal-cache
 			;;
 		"macOS")
 			case "${ARCH}" in
-				"ARM64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/aarch64-apple-darwin-cabal-cache
+				"ARM64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental5/aarch64-apple-darwin-cabal-cache
 					;;
-				"64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental4/x86_64-apple-darwin-cabal-cache
+				"64") url=https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-cache/experimental5/x86_64-apple-darwin-cabal-cache
 					;;
 			esac
 			;;
@@ -151,7 +151,7 @@ install_ghcup() {
 		chmod +x ghcup
 		mv ghcup "$HOME/.local/bin/ghcup"
 	else
-		curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_MINIMAL=1 sh
+		curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_MINIMAL=1 BOOTSTRAP_HASKELL_INSTALL_NO_STACK=yes sh
 	fi
 }
 

.github/workflows/release.yaml

@@ -319,7 +319,7 @@ jobs:
 
       - if: matrix.ARCH == 'ARM'
         uses: docker://hasufell/arm32v7-ubuntu-haskell:focal
-        name: Run build (armv7 linux)
+        name: Run test (armv7 linux)
         with:
           args: sh .github/scripts/test.sh
         env:
@@ -330,7 +330,7 @@ jobs:
 
       - if: matrix.ARCH == 'ARM64'
         uses: docker://hasufell/arm64v8-ubuntu-haskell:focal
-        name: Run build (aarch64 linux)
+        name: Run test (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,7 +116,8 @@ 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" <> help "How long the yaml metadata caching interval is (in seconds), 0 to disable" <> internal))
+    <*> 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-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

@@ -124,6 +124,7 @@ 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
@@ -132,7 +133,7 @@ updateSettings UserSettings{..} Settings{..} =
        noNetwork'  = fromMaybe noNetwork uNoNetwork
        gpgSetting' = fromMaybe gpgSetting uGPGSetting
        platformOverride' = uPlatformOverride <|> platformOverride
-   in Settings cache' metaCache' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor platformOverride'
+   in Settings cache' metaCache' metaMode' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor platformOverride'
 
 
 

app/ghcup/GHCup/OptParse/Install.hs

@@ -454,7 +454,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
            (_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS
            -- TODO: support legacy
            liftE $ runBothE' (installHLSBindist
-                                      (DownloadInfo uri (Just $ RegexDir "haskell-language-server-*") "" Nothing)
+                                      (DownloadInfo uri (if isWindows then Nothing else Just (RegexDir "haskell-language-server-*")) "" Nothing)
                                       v
                                       (maybe GHCupInternal IsolateDir isolateDir)
                                       forceInstall

app/ghcup/Main.hs

@@ -79,6 +79,7 @@ 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,6 +40,12 @@ 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,17 +162,21 @@ getBase :: ( MonadReader env m
            , MonadMask m
            )
         => URI
-        -> Excepts '[GPGError, DigestError, ContentLengthError, JSONError, FileDoesNotExistError] m GHCupInfo
+        -> Excepts '[DownloadFailed, GPGError, DigestError, ContentLengthError, JSONError, FileDoesNotExistError] m GHCupInfo
 getBase uri = do
-  Settings { noNetwork, downloader } <- lift getSettings
+  Settings { noNetwork, downloader, metaMode } <- 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 -> lift (warnCache (displayException e) downloader) >> pure Nothing)
+           else handleIO (\e -> case metaMode of
-               . catchE @_ @_ @'[] (\e@(DownloadFailed _) -> lift (warnCache (prettyShow e) downloader) >> pure Nothing)
+                                  Strict -> throwIO e
+                                  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
@@ -336,7 +340,6 @@ download uri gpgUri eDigest eCSize dest mfn etags
   | scheme == "file"  = do
       let destFile' = T.unpack . decUTF8Safe $ view pathL' uri
       lift $ logDebug $ "using local file: " <> T.pack destFile'
-      forM_ eCSize  (liftE . flip checkCSize  destFile')
       forM_ eDigest (liftE . flip checkDigest destFile')
       pure destFile'
   | otherwise = throwE $ DownloadFailed (variantFromValue UnsupportedScheme)
@@ -444,7 +447,6 @@ download uri gpgUri eDigest eCSize dest mfn etags
         liftE $ lEM @_ @'[ProcessError] $ exec "curl"
             (o' ++ (if etags then ["--dump-header", dh] else [])
                 ++ maybe [] (\t -> ["-H", "If-None-Match: " <> T.unpack t]) metag
-                ++ maybe [] (\s -> ["--max-file-size", show s]) eCSize
                 ++ ["-fL", "-o", destFileTemp, T.unpack uri']) Nothing Nothing
         headers <- liftIO $ T.readFile dh
 

lib/GHCup/Prelude/File/Posix.hs

@@ -48,6 +48,7 @@ import           Streamly.Internal.Data.Unfold.Type
 import qualified Streamly.Internal.Data.Unfold as U
 import           Streamly.Internal.Control.Concurrent ( withRunInIO )
 import           Streamly.Internal.Data.IOFinalizer   ( newIOFinalizer, runIOFinalizer )
+import GHC.IO.Exception (IOException(ioe_type), IOErrorType (..))
 
 
 -- | On unix, we can use symlinks, so we just get the
@@ -116,8 +117,18 @@ copyFile from to fail' = do
         let dflags = [ FD.oNofollow
                      , if fail' then FD.oExcl else FD.oTrunc
                      ]
+        let openFdHandle' = openFdHandle to SPI.WriteOnly dflags $ Just sourceFileMode
         bracket
-          (openFdHandle to SPI.WriteOnly dflags $ Just sourceFileMode)
+          (handleIO (\e -> if
+                              -- if we copy from regular file to symlink, we need
+                              -- to delete the symlink
+                              | ioe_type e == InvalidArgument
+                              , not fail' -> do
+                                 removeLink to
+                                 openFdHandle'
+                              | otherwise -> throwIO e
+                    )
+            openFdHandle')
           (hClose . snd)
           $ \(_, tH) -> do
               hSetBinaryMode fH True

lib/GHCup/Types.hs

@@ -298,10 +298,16 @@ 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
@@ -315,13 +321,14 @@ data UserSettings = UserSettings
   deriving (Show, GHC.Generic)
 
 defaultUserSettings :: UserSettings
-defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
+defaultUserSettings = UserSettings Nothing 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
@@ -347,6 +354,7 @@ fromSettings Settings{..} (Just KeyBindings{..}) =
   in UserSettings {
       uCache = Just cache
     , uMetaCache = Just metaCache
+    , uMetaMode = Just metaMode
     , uNoVerify = Just noVerify
     , uVerbose = Just verbose
     , uKeepDirs = Just keepDirs
@@ -427,6 +435,7 @@ instance NFData LeanAppState
 data Settings = Settings
   { cache            :: Bool
   , metaCache        :: Integer
+  , metaMode         :: MetaMode
   , noVerify         :: Bool
   , keepDirs         :: KeepDirs
   , downloader       :: Downloader
@@ -443,7 +452,7 @@ defaultMetaCache :: Integer
 defaultMetaCache = 300 -- 5 minutes
 
 defaultSettings :: Settings
-defaultSettings = Settings False defaultMetaCache False Never Curl False GHCupURL False GPGNone False Nothing
+defaultSettings = Settings False defaultMetaCache Lax False Never Curl False GHCupURL False GPGNone False Nothing
 
 instance NFData Settings
 

lib/GHCup/Types/JSON.hs

@@ -43,6 +43,7 @@ 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))