Retry downloading the deprecated.json file

This commit is contained in:
Michael Snoyman 2020-03-13 12:14:37 +02:00
parent 34ec0783c3
commit bd40aeddd9
No known key found for this signature in database
GPG Key ID: 907EAE2F42B52046
2 changed files with 5 additions and 2 deletions

View File

@ -90,6 +90,7 @@ dependencies:
- file-embed - file-embed
- resource-pool - resource-pool
- containers - containers
- retry
default-extensions: default-extensions:
- OverloadedStrings - OverloadedStrings

View File

@ -63,7 +63,7 @@ import Stackage.Database.Types
import System.Environment (lookupEnv) import System.Environment (lookupEnv)
import UnliftIO.Concurrent (getNumCapabilities) import UnliftIO.Concurrent (getNumCapabilities)
import Web.PathPieces (fromPathPiece, toPathPiece) import Web.PathPieces (fromPathPiece, toPathPiece)
import qualified Control.Retry as Retry
hoogleKey :: SnapName -> Text hoogleKey :: SnapName -> Text
@ -143,7 +143,9 @@ newHoogleLocker env man = mkSingleRun hoogleLocker
getHackageDeprecations :: getHackageDeprecations ::
(HasLogFunc env, MonadReader env m, MonadIO m) => m [Deprecation] (HasLogFunc env, MonadReader env m, MonadIO m) => m [Deprecation]
getHackageDeprecations = do getHackageDeprecations = do
jsonResponseDeprecated <- httpJSONEither hackageDeprecatedUrl let policy = Retry.exponentialBackoff 50 <> Retry.limitRetries 5
jsonResponseDeprecated <-
liftIO $ Retry.recoverAll policy $ const $ httpJSONEither hackageDeprecatedUrl
case getResponseBody jsonResponseDeprecated of case getResponseBody jsonResponseDeprecated of
Left err -> do Left err -> do
logError $ logError $