Stabilize probe startup and throttled downloads

This commit is contained in:
ms2k 2026-07-20 00:35:38 +09:00
commit 68a92662c0

View file

@ -6,6 +6,8 @@ module Nuthatch.Probe.Oidc
, verifyPkceBoundary
) where
import Control.Concurrent (threadDelay)
import Control.Exception (SomeException, try)
import Data.Aeson
( FromJSON (..)
, eitherDecodeStrict'
@ -88,10 +90,12 @@ login :: ProbeContext -> Bool -> String -> String -> IO Session
login context verifyBoundary user suffix = do
let cookies = probeDirectory context </> "cookies-" <> suffix
idpCookies = probeDirectory context </> "idp-" <> suffix
started <- curl
[ "--cookie-jar", cookies
, probeBase context <> "/login"
]
started <-
retryTransport 20 $
curl
[ "--cookie-jar", cookies
, probeBase context <> "/login"
]
assertEqual "login redirect status" 303 (curlStatus started)
authorizationUrl <-
maybe (fail "login response omitted Location") (pure . B8.unpack) $
@ -397,3 +401,14 @@ replaceAll needle replacement value =
optionalEnv :: String -> IO (Maybe String)
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))