diff --git a/src/Xrefcheck/Progress.hs b/src/Xrefcheck/Progress.hs index e5763550..5ec9d07c 100644 --- a/src/Xrefcheck/Progress.hs +++ b/src/Xrefcheck/Progress.hs @@ -120,14 +120,14 @@ reportRetry item Progress{..} = Progress , .. } -setTaskTimestamp :: w -> Time Second -> Time Second -> Progress a w -> Progress a w -setTaskTimestamp _ ttc startTime Progress{..} = Progress +setTaskTimestamp :: Time Second -> Time Second -> Progress a w -> Progress a w +setTaskTimestamp ttc startTime Progress{..} = Progress { pTaskTimestamp = Just (TaskTimestamp ttc startTime) , .. } -getTaskTimestamp :: w -> Progress a w -> Maybe TaskTimestamp -getTaskTimestamp _ = pTaskTimestamp +getTaskTimestamp :: Progress a w -> Maybe TaskTimestamp +getTaskTimestamp = pTaskTimestamp removeTaskTimestamp :: Progress a w -> Progress a w removeTaskTimestamp Progress{..} = Progress diff --git a/src/Xrefcheck/Verify.hs b/src/Xrefcheck/Verify.hs index 99b717af..458cba15 100644 --- a/src/Xrefcheck/Verify.hs +++ b/src/Xrefcheck/Verify.hs @@ -550,10 +550,10 @@ verifyReference RIExternal (ELUrl url) -> VerifyProgress{ vrExternal = let vrExternalAdvanced = moveProgress url vrExternal in case mbRetryData of - Just (now, retryAfter) -> case getTaskTimestamp url vrExternal of + Just (now, retryAfter) -> case getTaskTimestamp vrExternal of Just (TaskTimestamp ttc start) | retryAfter +:+ now <= ttc +:+ start -> vrExternalAdvanced - _ -> setTaskTimestamp url retryAfter now vrExternalAdvanced + _ -> setTaskTimestamp retryAfter now vrExternalAdvanced Nothing -> vrExternalAdvanced, .. } , () ) diff --git a/tests/Test/Xrefcheck/TooManyRequestsSpec.hs b/tests/Test/Xrefcheck/TooManyRequestsSpec.hs index 559764f7..dc01ff48 100644 --- a/tests/Test/Xrefcheck/TooManyRequestsSpec.hs +++ b/tests/Test/Xrefcheck/TooManyRequestsSpec.hs @@ -48,7 +48,7 @@ test_tooManyRequests = testGroup "429 response tests" setRef <- newIORef S.empty progressRef <- newIORef VerifyProgress { vrLocal = initProgress 0 - , vrExternal = setTaskTimestamp "" (sec 3) (now -:- sec 1.5) + , vrExternal = setTaskTimestamp (sec 3) (now -:- sec 1.5) . reportSuccess "" $ initProgress 2 } @@ -57,7 +57,7 @@ test_tooManyRequests = testGroup "429 response tests" setRef progressRef progress <- vrExternal <$> readIORef progressRef - let ttc = ttTimeToCompletion <$> getTaskTimestamp "" progress + let ttc = ttTimeToCompletion <$> getTaskTimestamp progress flip assertBool (ttc == Just (sec 2)) $ "Expected time to completion be equal to " ++ show (Just $ sec 2) ++ ", but instead it's " ++ show ttc @@ -71,7 +71,7 @@ test_tooManyRequests = testGroup "429 response tests" setRef <- newIORef S.empty progressRef <- newIORef VerifyProgress { vrLocal = initProgress 0 - , vrExternal = setTaskTimestamp "" (sec 2) (now -:- sec 1.5) + , vrExternal = setTaskTimestamp (sec 2) (now -:- sec 1.5) . reportSuccess "" $ initProgress 2 } @@ -80,7 +80,7 @@ test_tooManyRequests = testGroup "429 response tests" setRef progressRef progress <- vrExternal <$> readIORef progressRef - let ttc = fromMaybe (sec 0) $ ttTimeToCompletion <$> getTaskTimestamp "" progress + let ttc = fromMaybe (sec 0) $ ttTimeToCompletion <$> getTaskTimestamp progress flip assertBool (sec 3 <= ttc && ttc <= sec 4) $ "Expected time to completion be within range (seconds): 3 <= x <= 4" ++ ", but instead it's " ++ show ttc @@ -95,7 +95,7 @@ test_tooManyRequests = testGroup "429 response tests" setRef <- newIORef S.empty progressRef <- newIORef VerifyProgress { vrLocal = initProgress 0 - , vrExternal = setTaskTimestamp "" (sec 1) (now -:- sec 1.5) + , vrExternal = setTaskTimestamp (sec 1) (now -:- sec 1.5) . reportSuccess "" $ initProgress 2 } @@ -104,7 +104,7 @@ test_tooManyRequests = testGroup "429 response tests" setRef progressRef progress <- vrExternal <$> readIORef progressRef - let ttc = ttTimeToCompletion <$> getTaskTimestamp "" progress + let ttc = ttTimeToCompletion <$> getTaskTimestamp progress flip assertBool (ttc == Just (sec 0)) $ "Expected time to completion be 0 seconds" ++ ", but instead it's " ++ show ttc