Stabilize probe startup and throttled downloads

This commit is contained in:
ms2k 2026-07-20 00:35:38 +09:00
commit 68a92662c0
2 changed files with 21 additions and 4 deletions

View file

@ -6,6 +6,8 @@ module Nuthatch.Probe.Oidc
, verifyPkceBoundary , verifyPkceBoundary
) where ) where
import Control.Concurrent (threadDelay)
import Control.Exception (SomeException, try)
import Data.Aeson import Data.Aeson
( FromJSON (..) ( FromJSON (..)
, eitherDecodeStrict' , eitherDecodeStrict'
@ -88,7 +90,9 @@ login :: ProbeContext -> Bool -> String -> String -> IO Session
login context verifyBoundary user suffix = do login context verifyBoundary user suffix = do
let cookies = probeDirectory context </> "cookies-" <> suffix let cookies = probeDirectory context </> "cookies-" <> suffix
idpCookies = probeDirectory context </> "idp-" <> suffix idpCookies = probeDirectory context </> "idp-" <> suffix
started <- curl started <-
retryTransport 20 $
curl
[ "--cookie-jar", cookies [ "--cookie-jar", cookies
, probeBase context <> "/login" , probeBase context <> "/login"
] ]
@ -397,3 +401,14 @@ replaceAll needle replacement value =
optionalEnv :: String -> IO (Maybe String) optionalEnv :: String -> IO (Maybe String)
optionalEnv = lookupEnv optionalEnv = lookupEnv
retryTransport :: Int -> IO value -> IO value
retryTransport attempts action = do
result <- try action
case result of
Right value -> pure value
Left exception
| attempts > 1 -> do
threadDelay 100000
retryTransport (attempts - 1) action
| otherwise -> fail (show (exception :: SomeException))

View file

@ -167,6 +167,8 @@ verifyThrottle context session directory = do
, probeBase context , probeBase context
<> "/api/download?root=personal&path=streaming-large.bin" <> "/api/download?root=personal&path=streaming-large.bin"
]) :: IO (Either SomeException CurlResponse) ]) :: IO (Either SomeException CurlResponse)
BS.writeFile firstPath BS.empty
BS.writeFile secondPath BS.empty
(first, second) <- concurrently (downloadTo firstPath) (downloadTo secondPath) (first, second) <- concurrently (downloadTo firstPath) (downloadTo secondPath)
assert "first throttled download completed" (isLeft first) assert "first throttled download completed" (isLeft first)
assert "second throttled download completed" (isLeft second) assert "second throttled download completed" (isLeft second)