Yoo

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