Type ordinary integration probe HTTP traffic

This commit is contained in:
ms2k 2026-07-20 23:06:01 +09:00
commit cc5c47f2ce

View file

@ -25,13 +25,16 @@ import Database.Redis
)
import Nuthatch.Probe.Assert
import Nuthatch.Probe.Curl
import Nuthatch.Probe.Http hiding (get)
import qualified Nuthatch.Probe.Http as Http
main :: IO ()
main = do
client <- newProbeClient
verifyPostgres
verifyCoordination "redis"
verifyCoordination "dragonfly"
verifyOidc
verifyOidc client
verifyTarget
"Garage"
"http://garage:3900"
@ -84,15 +87,15 @@ verifyCoordination host =
(Right (Just "passed"))
loaded)
verifyOidc :: IO ()
verifyOidc =
verifyOidc :: ProbeClient -> IO ()
verifyOidc client =
mapM_
(\(label, url, marker) ->
retry label 30 $ do
response <- curl [url]
response <- Http.get client url
pure
( curlStatus response == 200
&& marker `B8.isInfixOf` curlBody response
( probeStatus response == 200
&& marker `B8.isInfixOf` probeBody response
))
[ ( "Keycloak discovery"
, "http://keycloak.nuthatch.test:8080/realms/master/.well-known/openid-configuration"
@ -144,9 +147,9 @@ verifyTarget label endpoint region accessKey secretKey createBucket = do
assert
( label
<> " bucket creation failed: "
<> B8.unpack (curlBody created)
<> B8.unpack (probeBody created)
) $
curlStatus created `elem` [200, 409]
probeStatus created `elem` [200, 409]
else pure ()
uploaded <- retryResponse 30 $ curl
( signed
@ -158,9 +161,9 @@ verifyTarget label endpoint region accessKey secretKey createBucket = do
]
)
assertEqual
(label <> " upload: " <> B8.unpack (curlBody uploaded))
(label <> " upload: " <> B8.unpack (probeBody uploaded))
200
(curlStatus uploaded)
(probeStatus uploaded)
downloaded <- curl
( signed
<> [ "--header"
@ -168,10 +171,10 @@ verifyTarget label endpoint region accessKey secretKey createBucket = do
, bucket <> "/probe/payload"
]
)
assertEqual (label <> " download status") 200 (curlStatus downloaded)
assertEqual (label <> " download status") 200 (probeStatus downloaded)
assertEqual (label <> " object body")
(B8.pack payload)
(curlBody downloaded)
(probeBody downloaded)
retry :: String -> Int -> IO Bool -> IO ()
retry label attempts action =
@ -184,13 +187,13 @@ retry label attempts action =
then fail (label <> " did not become available")
else threadDelay 1000000 >> go (remaining - 1)
retryResponse :: Int -> IO CurlResponse -> IO CurlResponse
retryResponse :: Int -> IO ProbeResponse -> IO ProbeResponse
retryResponse attempts action =
go attempts
where
go remaining = do
response <- action
if curlStatus response == 200 || remaining <= 1
if probeStatus response == 200 || remaining <= 1
then pure response
else threadDelay 1000000 >> go (remaining - 1)