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,20 +138,18 @@ 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
+        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
@@ -158,8 +162,10 @@ getDownloads = 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