Yoo
This commit is contained in:
parent
b87d252fec
commit
673bfef443
@ -71,6 +71,7 @@ import qualified Data.Map.Strict as M
|
|||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.Encoding as E
|
import qualified Data.Text.Encoding as E
|
||||||
import qualified System.IO.Streams as Streams
|
import qualified System.IO.Streams as Streams
|
||||||
|
import qualified System.Posix.Files.ByteString as PF
|
||||||
import qualified System.Posix.RawFilePath.Directory
|
import qualified System.Posix.RawFilePath.Directory
|
||||||
as RD
|
as RD
|
||||||
|
|
||||||
@ -111,10 +112,15 @@ getDownloads = do
|
|||||||
(OwnSpec av) -> pure $ av
|
(OwnSpec av) -> pure $ av
|
||||||
|
|
||||||
where
|
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
|
-- Only download the file if the modification time is newer
|
||||||
-- than the local file. Always save the local file with the
|
-- than the local file.
|
||||||
-- mod time of the remote file.
|
--
|
||||||
|
-- Always save the local file with the mod time of the remote file.
|
||||||
dl :: forall m1
|
dl :: forall m1
|
||||||
. (MonadCatch m1, MonadIO m1, MonadFail m1, MonadLogger m1)
|
. (MonadCatch m1, MonadIO m1, MonadFail m1, MonadLogger m1)
|
||||||
=> URI
|
=> URI
|
||||||
@ -132,34 +138,34 @@ getDownloads = do
|
|||||||
let path = view pathL' uri'
|
let path = view pathL' uri'
|
||||||
json_file <- (liftIO $ ghcupCacheDir)
|
json_file <- (liftIO $ ghcupCacheDir)
|
||||||
>>= \cacheDir -> (cacheDir </>) <$> urlBaseName path
|
>>= \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
|
e <- liftIO $ doesFileExist json_file
|
||||||
if e
|
if e
|
||||||
then do
|
then do
|
||||||
case mModT of
|
accessTime <-
|
||||||
Just modTime -> do
|
PF.accessTimeHiRes
|
||||||
fileMod <- liftIO $ getModificationTime json_file
|
<$> (liftIO $ PF.getFileStatus (toFilePath json_file))
|
||||||
if modTime > fileMod
|
currentTime <- liftIO $ getPOSIXTime
|
||||||
then do
|
|
||||||
bs <- liftE $ downloadBS uri'
|
-- access time won't work on most linuxes, but we can try regardless
|
||||||
liftIO $ writeFileWithModTime modTime json_file bs
|
if (currentTime - accessTime) > 300
|
||||||
pure bs
|
then do -- no access in last 5 minutes, re-check upstream mod time
|
||||||
else liftIO $ readFile json_file
|
getModTime >>= \case
|
||||||
Nothing -> do
|
Just modTime -> do
|
||||||
lift $ $(logWarn) [i|Unable to get/parse Last-Modified header|]
|
fileMod <- liftIO $ getModificationTime json_file
|
||||||
liftIO $ deleteFile json_file
|
if modTime > fileMod
|
||||||
liftE $ downloadBS uri'
|
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
|
else do
|
||||||
case mModT of
|
getModTime >>= \case
|
||||||
Just modTime -> do
|
Just modTime -> do
|
||||||
bs <- liftE $ downloadBS uri'
|
bs <- liftE $ downloadBS uri'
|
||||||
liftIO $ writeFileWithModTime modTime json_file bs
|
liftIO $ writeFileWithModTime modTime json_file bs
|
||||||
@ -168,6 +174,20 @@ getDownloads = do
|
|||||||
lift $ $(logWarn) [i|Unable to get/parse Last-Modified header|]
|
lift $ $(logWarn) [i|Unable to get/parse Last-Modified header|]
|
||||||
liftE $ downloadBS uri'
|
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 :: (M.Map (CI ByteString) ByteString) -> Maybe UTCTime
|
||||||
parseModifiedHeader headers =
|
parseModifiedHeader headers =
|
||||||
(M.lookup (CI.mk [s|Last-Modified|]) headers) >>= \h -> parseTimeM
|
(M.lookup (CI.mk [s|Last-Modified|]) headers) >>= \h -> parseTimeM
|
||||||
|
Loading…
Reference in New Issue
Block a user