Stabilize probe startup and throttled downloads
This commit is contained in:
parent
dbff8c586d
commit
68a92662c0
1 changed files with 21 additions and 4 deletions
|
|
@ -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))
|
||||
|
|
|
|||
Loading…
Reference in a new issue