Bound authentication probe startup synchronization

This commit is contained in:
ms2k 2026-07-20 05:22:08 +09:00
commit b196f9e17b
2 changed files with 36 additions and 7 deletions

View file

@ -1,14 +1,16 @@
module Main (main) where module Main (main) where
import Control.Concurrent (threadDelay)
import Control.Exception (throwIO, try)
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as B16 import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Char8 as B8
import Data.List (find) import Data.List (find)
import System.Entropy (getEntropy)
import Nuthatch.Probe.Assert import Nuthatch.Probe.Assert
import Nuthatch.Probe.Curl import Nuthatch.Probe.Curl
import Nuthatch.Probe.Oidc import Nuthatch.Probe.Oidc
import Nuthatch.Probe.ProductClient import Nuthatch.Probe.ProductClient
import System.Entropy (getEntropy)
import System.IO.Temp (withSystemTempDirectory) import System.IO.Temp (withSystemTempDirectory)
main :: IO () main :: IO ()
@ -17,6 +19,7 @@ main =
context <- newProbeContext directory context <- newProbeContext directory
runId <- B8.unpack . B16.encode <$> getEntropy 8 runId <- B8.unpack . B16.encode <$> getEntropy 8
verifyCredentialScope verifyCredentialScope
waitForApplication context
verifyPublicBoundary context verifyPublicBoundary context
userA <- requireEnv "NUTHATCH_OIDC_USER_A" userA <- requireEnv "NUTHATCH_OIDC_USER_A"
sessionA <- login context True userA "a" sessionA <- login context True userA "a"
@ -28,6 +31,25 @@ main =
verifyLogout context sessionA verifyLogout context sessionA
putStrLn "OIDC application boundary passed" putStrLn "OIDC application boundary passed"
waitForApplication :: ProbeContext -> IO ()
waitForApplication context = go 30
where
go :: Int -> IO ()
go remaining = do
result <-
try (curl
[ "--connect-timeout", "1"
, "--max-time", "2"
, probeBase context <> "/readyz"
])
:: IO (Either CurlTransportFailure CurlResponse)
case result of
Right _ -> pure ()
Left failure
| curlTransportExitCode failure == 7 && remaining > 1 ->
threadDelay 1000000 >> go (remaining - 1)
| otherwise -> throwIO failure
verifyCredentialScope :: IO () verifyCredentialScope :: IO ()
verifyCredentialScope = do verifyCredentialScope = do
endpoint <- requireEnv "NUTHATCH_S3_ENDPOINT" endpoint <- requireEnv "NUTHATCH_S3_ENDPOINT"

View file

@ -1,5 +1,6 @@
module Nuthatch.Probe.Curl module Nuthatch.Probe.Curl
( CurlResponse (..) ( CurlResponse (..)
, CurlTransportFailure (..)
, cookieValue , cookieValue
, curl , curl
, curlToFile , curlToFile
@ -7,6 +8,7 @@ module Nuthatch.Probe.Curl
, headerValues , headerValues
) where ) where
import Control.Exception (Exception, throwIO)
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Char8 as B8
import Data.Char (toLower) import Data.Char (toLower)
@ -23,6 +25,13 @@ data CurlResponse = CurlResponse
, curlBody :: BS.ByteString , curlBody :: BS.ByteString
} deriving stock (Eq, Show) } deriving stock (Eq, Show)
data CurlTransportFailure = CurlTransportFailure
{ curlTransportExitCode :: Int
, curlTransportStderr :: String
} deriving stock (Eq, Show)
instance Exception CurlTransportFailure
curl :: [String] -> IO CurlResponse curl :: [String] -> IO CurlResponse
curl arguments = curl arguments =
withSystemTempDirectory "nuthatch-curl" $ \directory -> do withSystemTempDirectory "nuthatch-curl" $ \directory -> do
@ -56,12 +65,10 @@ runCurl outputPath arguments =
case exitCode of case exitCode of
ExitSuccess -> pure () ExitSuccess -> pure ()
ExitFailure code -> ExitFailure code ->
fail throwIO CurlTransportFailure
( "curl transport failed with exit " { curlTransportExitCode = code
<> show code , curlTransportStderr = stderrText
<> ": " }
<> stderrText
)
headers <- parseHeaders <$> BS.readFile headersPath headers <- parseHeaders <$> BS.readFile headersPath
pure CurlResponse pure CurlResponse
{ curlStatus = status { curlStatus = status