Allow to control the metadata cache, fixes #278

This commit is contained in:
Julian Ospald 2021-10-30 13:23:02 +02:00
parent 7bb67dd4c6
commit 190b5dedba
Signed by: hasufell
GPG Key ID: 3786C5262ECB4A3F
12 changed files with 60 additions and 28 deletions

View File

@ -536,17 +536,7 @@ settings' = unsafePerformIO $ do
, fileOutter = \_ -> pure () , fileOutter = \_ -> pure ()
, fancyColors = True , fancyColors = True
} }
newIORef $ AppState (Settings { cache = True newIORef $ AppState defaultSettings
, noVerify = False
, keepDirs = Never
, downloader = Curl
, verbose = False
, urlSource = GHCupURL
, noNetwork = False
, gpgSetting = GPGNone
, noColor = False
, ..
})
dirs dirs
defaultKeyBindings defaultKeyBindings
(GHCupInfo mempty mempty mempty) (GHCupInfo mempty mempty mempty)

View File

@ -67,6 +67,7 @@ data Options = Options
-- global options -- global options
optVerbose :: Maybe Bool optVerbose :: Maybe Bool
, optCache :: Maybe Bool , optCache :: Maybe Bool
, optMetaCache :: Maybe Integer
, optUrlSource :: Maybe URI , optUrlSource :: Maybe URI
, optNoVerify :: Maybe Bool , optNoVerify :: Maybe Bool
, optKeepDirs :: Maybe KeepDirs , optKeepDirs :: Maybe KeepDirs
@ -105,6 +106,7 @@ opts =
Options Options
<$> invertableSwitch "verbose" 'v' False (help "Enable verbosity (default: disabled)") <$> invertableSwitch "verbose" 'v' False (help "Enable verbosity (default: disabled)")
<*> invertableSwitch "cache" 'c' False (help "Cache downloads in ~/.ghcup/cache (default: disabled)") <*> invertableSwitch "cache" '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 <*> optional
(option (option
(eitherReader parseUri) (eitherReader parseUri)

View File

@ -299,7 +299,7 @@ tagCompleter tool add = listIOCompleter $ do
, fancyColors = False , fancyColors = False
} }
let appState = LeanAppState let appState = LeanAppState
(Settings True False Never Curl False GHCupURL True GPGNone False) (defaultSettings { noNetwork = True })
dirs' dirs'
defaultKeyBindings defaultKeyBindings
loggerConfig loggerConfig
@ -322,7 +322,7 @@ versionCompleter criteria tool = listIOCompleter $ do
, fileOutter = mempty , fileOutter = mempty
, fancyColors = False , fancyColors = False
} }
let settings = Settings True False Never Curl False GHCupURL True GPGNone False let settings = defaultSettings { noNetwork = True }
let leanAppState = LeanAppState let leanAppState = LeanAppState
settings settings
dirs' dirs'

View File

@ -122,6 +122,7 @@ updateSettings config' settings = do
mergeConf :: UserSettings -> Settings -> Settings mergeConf :: UserSettings -> Settings -> Settings
mergeConf UserSettings{..} Settings{..} = mergeConf UserSettings{..} Settings{..} =
let cache' = fromMaybe cache uCache let cache' = fromMaybe cache uCache
metaCache' = fromMaybe metaCache uMetaCache
noVerify' = fromMaybe noVerify uNoVerify noVerify' = fromMaybe noVerify uNoVerify
keepDirs' = fromMaybe keepDirs uKeepDirs keepDirs' = fromMaybe keepDirs uKeepDirs
downloader' = fromMaybe downloader uDownloader downloader' = fromMaybe downloader uDownloader
@ -129,7 +130,7 @@ updateSettings config' settings = do
urlSource' = fromMaybe urlSource uUrlSource urlSource' = fromMaybe urlSource uUrlSource
noNetwork' = fromMaybe noNetwork uNoNetwork noNetwork' = fromMaybe noNetwork uNoNetwork
gpgSetting' = fromMaybe gpgSetting uGPGSetting gpgSetting' = fromMaybe gpgSetting uGPGSetting
in Settings cache' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor in Settings cache' metaCache' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor

View File

@ -51,7 +51,7 @@ describe_result = $( LitE . StringL <$>
runIO (do runIO (do
CapturedProcess{..} <- do CapturedProcess{..} <- do
dirs <- liftIO getAllDirs dirs <- liftIO getAllDirs
let settings = AppState (Settings True False Never Curl False GHCupURL False GPGNone False) let settings = AppState (defaultSettings { noNetwork = True })
dirs dirs
defaultKeyBindings defaultKeyBindings
flip runReaderT settings $ executeOut "git" ["describe"] Nothing flip runReaderT settings $ executeOut "git" ["describe"] Nothing

View File

@ -55,6 +55,7 @@ import qualified Data.ByteString as B
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.IO as T import qualified Data.Text.IO as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
import qualified GHCup.Types as Types
@ -72,15 +73,16 @@ toSettings options = do
where where
mergeConf :: Options -> UserSettings -> Bool -> (Settings, KeyBindings) mergeConf :: Options -> UserSettings -> Bool -> (Settings, KeyBindings)
mergeConf Options{..} UserSettings{..} noColor = mergeConf Options{..} UserSettings{..} noColor =
let cache = fromMaybe (fromMaybe False uCache) optCache let cache = fromMaybe (fromMaybe (Types.cache defaultSettings) uCache) optCache
noVerify = fromMaybe (fromMaybe False uNoVerify) optNoVerify metaCache = fromMaybe (fromMaybe (Types.metaCache defaultSettings) uMetaCache) optMetaCache
verbose = fromMaybe (fromMaybe False uVerbose) optVerbose noVerify = fromMaybe (fromMaybe (Types.noVerify defaultSettings) uNoVerify) optNoVerify
keepDirs = fromMaybe (fromMaybe Errors uKeepDirs) optKeepDirs verbose = fromMaybe (fromMaybe (Types.verbose defaultSettings) uVerbose) optVerbose
keepDirs = fromMaybe (fromMaybe (Types.keepDirs defaultSettings) uKeepDirs) optKeepDirs
downloader = fromMaybe (fromMaybe defaultDownloader uDownloader) optsDownloader downloader = fromMaybe (fromMaybe defaultDownloader uDownloader) optsDownloader
keyBindings = maybe defaultKeyBindings mergeKeys uKeyBindings keyBindings = maybe defaultKeyBindings mergeKeys uKeyBindings
urlSource = maybe (fromMaybe GHCupURL uUrlSource) OwnSource optUrlSource urlSource = maybe (fromMaybe (Types.urlSource defaultSettings) uUrlSource) OwnSource optUrlSource
noNetwork = fromMaybe (fromMaybe False uNoNetwork) optNoNetwork noNetwork = fromMaybe (fromMaybe (Types.noNetwork defaultSettings) uNoNetwork) optNoNetwork
gpgSetting = fromMaybe (fromMaybe GPGNone uGPGSetting) optGpg gpgSetting = fromMaybe (fromMaybe (Types.gpgSetting defaultSettings) uGPGSetting) optGpg
in (Settings {..}, keyBindings) in (Settings {..}, keyBindings)
#if defined(INTERNAL_DOWNLOADER) #if defined(INTERNAL_DOWNLOADER)
defaultDownloader = Internal defaultDownloader = Internal

View File

@ -36,6 +36,10 @@ key-bindings:
show-all-tools: show-all-tools:
KChar: 't' KChar: 't'
# The caching for the metadata files containing download info, depending on last access time
# of the file. These usually are in '~/.ghcup/cache/ghcup-<ver>.yaml'.
meta-cache: 300 # in seconds
# Where to get GHC/cabal/hls download info/versions from. For more detailed explanation # Where to get GHC/cabal/hls download info/versions from. For more detailed explanation
# check the 'URLSource' type in the code. # check the 'URLSource' type in the code.
url-source: url-source:

View File

@ -53,6 +53,25 @@ as e.g. `/etc/bash_completion.d/ghcup` (depending on distro)
and make sure your bashrc sources the startup script and make sure your bashrc sources the startup script
(`/usr/share/bash-completion/bash_completion` on some distros). (`/usr/share/bash-completion/bash_completion` on some distros).
## Caching
GHCup has a few caching mechanisms to avoid redownloads. All cached files end up in `~/.ghcup/cache` by default.
### Downloads cache
Downloaded tarballs (such as GHC, cabal, etc.) are not cached by default unless you pass `ghcup --cache` or set caching
in your [config](#configuration) via `ghcup config set cache true`.
### Metadata cache
The metadata files (also see [github.com/haskell/ghcup-metadata](https://github.com/haskell/ghcup-metadata))
have a 5 minutes cache per default depending on the last access time of the file. That means if you run
`ghcup list` 10 times in a row, only the first time will trigger a download attempt.
### Clearing the cache
If you experience problems, consider clearing the cache via `ghcup gc --cache`.
## Compiling GHC from source ## Compiling GHC from source
Compiling from source is supported for both source tarballs and arbitrary git refs. See `ghcup compile ghc --help` Compiling from source is supported for both source tarballs and arbitrary git refs. See `ghcup compile ghc --help`

View File

@ -242,14 +242,18 @@ getBase uri = do
e <- liftIO $ doesFileExist json_file e <- liftIO $ doesFileExist json_file
currentTime <- liftIO getCurrentTime currentTime <- liftIO getCurrentTime
Dirs { cacheDir } <- lift getDirs Dirs { cacheDir } <- lift getDirs
Settings { metaCache } <- lift getSettings
-- for local files, let's short-circuit and ignore access time -- for local files, let's short-circuit and ignore access time
if | scheme == "file" -> liftE $ download uri' Nothing Nothing cacheDir Nothing True if | scheme == "file" -> liftE $ download uri' Nothing Nothing cacheDir Nothing True
| e -> do | e -> do
accessTime <- liftIO $ getAccessTime json_file accessTime <- fmap utcTimeToPOSIXSeconds $ liftIO $ getAccessTime json_file
let sinceLastAccess = utcTimeToPOSIXSeconds currentTime - accessTime
let cacheInterval = fromInteger metaCache
lift $ logDebug $ "last access was " <> T.pack (show sinceLastAccess) <> " ago, cache interval is " <> T.pack (show cacheInterval)
-- access time won't work on most linuxes, but we can try regardless -- access time won't work on most linuxes, but we can try regardless
if | ((utcTimeToPOSIXSeconds currentTime - utcTimeToPOSIXSeconds accessTime) > 300) -> if | metaCache <= 0 -> dlWithMod currentTime json_file
| (sinceLastAccess > cacheInterval) ->
-- no access in last 5 minutes, re-check upstream mod time -- no access in last 5 minutes, re-check upstream mod time
dlWithMod currentTime json_file dlWithMod currentTime json_file
| otherwise -> pure json_file | otherwise -> pure json_file

View File

@ -294,6 +294,7 @@ instance NFData (URIRef Absolute) where
data UserSettings = UserSettings data UserSettings = UserSettings
{ uCache :: Maybe Bool { uCache :: Maybe Bool
, uMetaCache :: Maybe Integer
, uNoVerify :: Maybe Bool , uNoVerify :: Maybe Bool
, uVerbose :: Maybe Bool , uVerbose :: Maybe Bool
, uKeepDirs :: Maybe KeepDirs , uKeepDirs :: Maybe KeepDirs
@ -306,12 +307,13 @@ data UserSettings = UserSettings
deriving (Show, GHC.Generic) deriving (Show, GHC.Generic)
defaultUserSettings :: UserSettings defaultUserSettings :: UserSettings
defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
fromSettings :: Settings -> Maybe KeyBindings -> UserSettings fromSettings :: Settings -> Maybe KeyBindings -> UserSettings
fromSettings Settings{..} Nothing = fromSettings Settings{..} Nothing =
UserSettings { UserSettings {
uCache = Just cache uCache = Just cache
, uMetaCache = Just metaCache
, uNoVerify = Just noVerify , uNoVerify = Just noVerify
, uVerbose = Just verbose , uVerbose = Just verbose
, uKeepDirs = Just keepDirs , uKeepDirs = Just keepDirs
@ -335,6 +337,7 @@ fromSettings Settings{..} (Just KeyBindings{..}) =
} }
in UserSettings { in UserSettings {
uCache = Just cache uCache = Just cache
, uMetaCache = Just metaCache
, uNoVerify = Just noVerify , uNoVerify = Just noVerify
, uVerbose = Just verbose , uVerbose = Just verbose
, uKeepDirs = Just keepDirs , uKeepDirs = Just keepDirs
@ -410,6 +413,7 @@ instance NFData LeanAppState
data Settings = Settings data Settings = Settings
{ cache :: Bool { cache :: Bool
, metaCache :: Integer
, noVerify :: Bool , noVerify :: Bool
, keepDirs :: KeepDirs , keepDirs :: KeepDirs
, downloader :: Downloader , downloader :: Downloader
@ -421,6 +425,12 @@ data Settings = Settings
} }
deriving (Show, GHC.Generic) deriving (Show, GHC.Generic)
defaultMetaCache :: Integer
defaultMetaCache = 300 -- 5 minutes
defaultSettings :: Settings
defaultSettings = Settings False defaultMetaCache False Never Curl False GHCupURL False GPGNone False
instance NFData Settings instance NFData Settings
data Dirs = Dirs data Dirs = Dirs

View File

@ -111,7 +111,7 @@ import qualified Data.List.NonEmpty as NE
-- >>> let lc = LoggerConfig { lcPrintDebug = False, consoleOutter = mempty, fileOutter = mempty, fancyColors = False } -- >>> let lc = LoggerConfig { lcPrintDebug = False, consoleOutter = mempty, fileOutter = mempty, fancyColors = False }
-- >>> dirs' <- getAllDirs -- >>> dirs' <- getAllDirs
-- >>> let installedVersions = [ ([pver|8.10.7|], Nothing), ([pver|8.10.4|], Nothing), ([pver|8.8.4|], Nothing), ([pver|8.8.3|], Nothing) ] -- >>> let installedVersions = [ ([pver|8.10.7|], Nothing), ([pver|8.10.4|], Nothing), ([pver|8.8.4|], Nothing), ([pver|8.8.3|], Nothing) ]
-- >>> let settings = Settings True False Never Curl False GHCupURL True GPGNone False -- >>> let settings = Settings True 0 False Never Curl False GHCupURL True GPGNone False
-- >>> let leanAppState = LeanAppState settings dirs' defaultKeyBindings lc -- >>> let leanAppState = LeanAppState settings dirs' defaultKeyBindings lc
-- >>> cwd <- getCurrentDirectory -- >>> cwd <- getCurrentDirectory
-- >>> (Right ref) <- pure $ parseURI strictURIParserOptions $ "file://" <> E.encodeUtf8 (T.pack cwd) <> "/data/metadata/" <> (urlBaseName . view pathL' $ ghcupURL) -- >>> (Right ref) <- pure $ parseURI strictURIParserOptions $ "file://" <> E.encodeUtf8 (T.pack cwd) <> "/data/metadata/" <> (urlBaseName . view pathL' $ ghcupURL)

View File

@ -3,7 +3,7 @@
module GHCup.Types.JSONSpec where module GHCup.Types.JSONSpec where
import GHCup.ArbitraryTypes () import GHCup.ArbitraryTypes ()
import GHCup.Types import GHCup.Types hiding ( defaultSettings )
import GHCup.Types.JSON () import GHCup.Types.JSON ()
import Test.Aeson.GenericSpecs import Test.Aeson.GenericSpecs