diff --git a/lib/GHCup/Download.hs b/lib/GHCup/Download.hs index 4e280c6..123830a 100644 --- a/lib/GHCup/Download.hs +++ b/lib/GHCup/Download.hs @@ -71,6 +71,7 @@ import qualified Data.Map.Strict as M import qualified Data.Text as T import qualified Data.Text.Encoding as E import qualified System.IO.Streams as Streams +import qualified System.Posix.Files.ByteString as PF import qualified System.Posix.RawFilePath.Directory as RD @@ -111,10 +112,15 @@ getDownloads = do (OwnSpec av) -> pure $ av where - -- First send a HEAD request and check for modification time. + -- First check if the json file is in the ~/.ghcup/cache dir + -- and check it's access time. If it has been accessed within the + -- last 5 minutes, just reuse it. + -- + -- If not, then send a HEAD request and check for modification time. -- Only download the file if the modification time is newer - -- than the local file. Always save the local file with the - -- mod time of the remote file. + -- than the local file. + -- + -- Always save the local file with the mod time of the remote file. dl :: forall m1 . (MonadCatch m1, MonadIO m1, MonadFail m1, MonadLogger m1) => URI @@ -132,34 +138,34 @@ getDownloads = do let path = view pathL' uri' json_file <- (liftIO $ ghcupCacheDir) >>= \cacheDir -> (cacheDir ) <$> urlBaseName path - headers <- - handleIO (\_ -> pure mempty) - $ liftE - $ ( catchAllE - (\_ -> - pure mempty :: Excepts '[] m1 (M.Map (CI ByteString) ByteString) - ) - $ getHead uri' - ) - let mModT = parseModifiedHeader headers e <- liftIO $ doesFileExist json_file if e then do - case mModT of - Just modTime -> do - fileMod <- liftIO $ getModificationTime json_file - if modTime > fileMod - then do - bs <- liftE $ downloadBS uri' - liftIO $ writeFileWithModTime modTime json_file bs - pure bs - else liftIO $ readFile json_file - Nothing -> do - lift $ $(logWarn) [i|Unable to get/parse Last-Modified header|] - liftIO $ deleteFile json_file - liftE $ downloadBS uri' + accessTime <- + PF.accessTimeHiRes + <$> (liftIO $ PF.getFileStatus (toFilePath json_file)) + currentTime <- liftIO $ getPOSIXTime + + -- access time won't work on most linuxes, but we can try regardless + if (currentTime - accessTime) > 300 + then do -- no access in last 5 minutes, re-check upstream mod time + getModTime >>= \case + Just modTime -> do + fileMod <- liftIO $ getModificationTime json_file + if modTime > fileMod + then do + bs <- liftE $ downloadBS uri' + liftIO $ writeFileWithModTime modTime json_file bs + pure bs + else liftIO $ readFile json_file + Nothing -> do + lift $ $(logWarn) [i|Unable to get/parse Last-Modified header|] + liftIO $ deleteFile json_file + liftE $ downloadBS uri' + else -- access in less than 5 minutes, re-use file + liftIO $ readFile json_file else do - case mModT of + getModTime >>= \case Just modTime -> do bs <- liftE $ downloadBS uri' liftIO $ writeFileWithModTime modTime json_file bs @@ -168,6 +174,20 @@ getDownloads = do lift $ $(logWarn) [i|Unable to get/parse Last-Modified header|] liftE $ downloadBS uri' + where + getModTime = do + headers <- + handleIO (\_ -> pure mempty) + $ liftE + $ ( catchAllE + (\_ -> + pure mempty :: Excepts '[] m1 (M.Map (CI ByteString) ByteString) + ) + $ getHead uri' + ) + pure $ parseModifiedHeader headers + + parseModifiedHeader :: (M.Map (CI ByteString) ByteString) -> Maybe UTCTime parseModifiedHeader headers = (M.lookup (CI.mk [s|Last-Modified|]) headers) >>= \h -> parseTimeM