module Main (main) where import Control.Concurrent (threadDelay) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as B8 import Nuthatch.Probe.Assert import Nuthatch.Probe.Curl import Nuthatch.Probe.Oidc import Nuthatch.Probe.ProductClient import System.Environment (getArgs) import System.IO (hFlush, stdout) import System.IO.Temp (withSystemTempDirectory) import Text.Read (readMaybe) main :: IO () main = withSystemTempDirectory "nuthatch-runtime-http-probe" $ \directory -> do context <- newProbeContext directory getArgs >>= \case ["health", expectedText] -> maybe (fail "invalid expected readiness status") (verifyHealth context) (readMaybe expectedText) ["baseline"] -> withSession context True "runtime-baseline" $ verifyBaseline context ["coherence"] -> verifyCoherence context ["redis-unavailable"] -> withSession context False "runtime-redis" $ verifyRedisUnavailable context ["database-unavailable"] -> withSession context False "runtime-database" $ verifyDatabaseUnavailable context _ -> fail "expected health STATUS, baseline, coherence, redis-unavailable, \ \or database-unavailable" withSession :: ProbeContext -> Bool -> String -> (Session -> IO ()) -> IO () withSession context verifyBoundary suffix action = do user <- requireEnv "NUTHATCH_OIDC_USER_A" login context verifyBoundary user suffix >>= action verifyHealth :: ProbeContext -> Int -> IO () verifyHealth context expectedReady = do health <- curl [probeBase context <> "/healthz"] assertEqual "runtime health status" 200 (curlStatus health) assertContains "runtime health body" "\"ok\":true" (curlBody health) ready <- curl [probeBase context <> "/readyz"] assertEqual "runtime readiness status" expectedReady (curlStatus ready) _ <- curl [probeBase context <> "/app"] session <- curl [probeBase context <> "/api/session"] assertEqual "runtime unauthenticated session" 303 (curlStatus session) putStrLn "Runtime health semantics passed" verifyBaseline :: ProbeContext -> Session -> IO () verifyBaseline context sessionA = do browsed <- browse context sessionA "" assertEqual "runtime baseline browse" 200 (curlStatus browsed) uploaded <- upload context sessionA "personal" "cross-user.txt" "76000000-0000-4000-8000-000000000001" "private-a" requireSucceeded "runtime baseline put" uploaded userB <- requireEnv "NUTHATCH_OIDC_USER_B" sessionB <- login context False userB "runtime-baseline-b" personalB <- browse context sessionB "?root=personal" assert "runtime personal cache crossed users" $ not ("cross-user.txt" `BS.isInfixOf` curlBody personalB) wrongLogout <- curl [ "--cookie", sessionCookies sessionA , "--header" , "X-CSRF-Token: bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" , "--request", "POST" , probeBase context <> "/logout" ] assert "runtime baseline accepted wrong logout CSRF" $ curlStatus wrongLogout >= 400 deleted <- deleteObject context sessionA "personal" "cross-user.txt" "76000000-0000-4000-8000-000000000002" requireSucceeded "runtime baseline delete" deleted restored <- upload context sessionA "personal" "cross-user.txt" "76000000-0000-4000-8000-000000000003" "private-a" requireSucceeded "runtime unavailable fixture" restored loggedOut <- curl [ "--cookie", sessionCookies sessionA , "--cookie-jar", sessionCookies sessionA , "--header", "X-CSRF-Token: " <> B8.unpack (sessionCsrf sessionA) , "--request", "POST" , probeBase context <> "/logout" ] assertEqual "runtime baseline logout" 200 (curlStatus loggedOut) putStrLn "Runtime audit baseline passed" verifyCoherence :: ProbeContext -> IO () verifyCoherence context = do userA <- requireEnv "NUTHATCH_OIDC_USER_A" userB <- requireEnv "NUTHATCH_OIDC_USER_B" sessionA <- login context False userA "runtime-coherence-a" sessionB <- login context False userB "runtime-coherence-b" sequence_ [ browse context sessionB "?root=shared" , browse context sessionB "?root=shared&prefix=runtime" , browse context sessionB "?root=shared" , browse context sessionB "?root=shared&prefix=runtime" ] uploaded <- upload context sessionA "shared" "runtime/coherence.txt" "74000000-0000-4000-8000-000000000001" "runtime-coherence" requireSucceeded "shared coherence upload" uploaded rootListing <- browse context sessionB "?root=shared" assertContains "shared root cache invalidation" "runtime" (curlBody rootListing) prefixListing <- browse context sessionB "?root=shared&prefix=runtime" assertContains "shared prefix cache invalidation" "coherence.txt" (curlBody prefixListing) deleted <- deleteObject context sessionA "shared" "runtime/coherence.txt" "74000000-0000-4000-8000-000000000002" requireSucceeded "shared coherence delete" deleted afterDelete <- browse context sessionB "?root=shared&prefix=runtime" assert "shared deletion remained in another replica cache" $ not ("coherence.txt" `BS.isInfixOf` curlBody afterDelete) threadDelay 2000000 browse context sessionB "?root=shared" >>= \response -> assertEqual "cache TTL browse" 200 (curlStatus response) putStrLn "Cross-user cache coherence and TTL passed" verifyRedisUnavailable :: ProbeContext -> Session -> IO () verifyRedisUnavailable context session = do listing <- browse context session "?root=personal" assertEqual "Redis-unavailable browse" 200 (curlStatus listing) assertContains "Redis-unavailable browse fixture" "cross-user.txt" (curlBody listing) searched <- browse context session "?root=personal&q=CROSS-USER" assertContains "Redis-unavailable search" "cross-user.txt" (curlBody searched) unavailableUpload <- upload context session "personal" "unavailable.bin" "72000000-0000-4000-8000-000000000001" "x" requireError "Redis-unavailable upload" 503 "throttle_unavailable" unavailableUpload unavailableDownload <- download context session "personal" "cross-user.txt" requireError "Redis-unavailable download" 503 "throttle_unavailable" unavailableDownload putStrLn "Redis-unavailable runtime behavior passed" verifyDatabaseUnavailable :: ProbeContext -> Session -> IO () verifyDatabaseUnavailable context session = do putStrLn "Database fault checkpoint" hFlush stdout threadDelay 10000000 unavailableUpload <- retryPastThrottle 5 $ upload context session "personal" "database-unavailable.txt" "75000000-0000-4000-8000-000000000001" "x" requireError "database-unavailable upload" 503 "mutation_rejected" unavailableUpload unavailableDelete <- deleteObject context session "personal" "cross-user.txt" "75000000-0000-4000-8000-000000000002" requireError "database-unavailable delete" 503 "mutation_rejected" unavailableDelete putStrLn "Database-unavailable mutation behavior passed" retryPastThrottle :: Int -> IO CurlResponse -> IO CurlResponse retryPastThrottle attempts action = do response <- action if attempts > 1 && "\"error\":\"throttle_unavailable\"" `BS.isInfixOf` curlBody response then threadDelay 250000 >> retryPastThrottle (attempts - 1) action else pure response requireSucceeded :: String -> CurlResponse -> IO () requireSucceeded label response = do assertEqual (label <> " status") 200 (curlStatus response) assertContains label "\"result\":\"succeeded\"" (curlBody response) requireError :: String -> Int -> BS.ByteString -> CurlResponse -> IO () requireError label status code response = do assertEqual (label <> " status") status (curlStatus response) assert (label <> " body: " <> B8.unpack (curlBody response)) (("\"error\":\"" <> code <> "\"") `BS.isInfixOf` curlBody response)