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.Http import Nuthatch.Probe.Oidc import Nuthatch.Probe.ProductClient import System.Environment (getArgs) import System.IO (hFlush, stdout) import Text.Read (readMaybe) main :: IO () main = do context <- newProbeContext 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 <- get (probeClient context) (probeBase context <> "/healthz") assertEqual "runtime health status" 200 (probeStatus health) assertContains "runtime health body" "\"ok\":true" (probeBody health) ready <- get (probeClient context) (probeBase context <> "/readyz") assertEqual "runtime readiness status" expectedReady (probeStatus ready) _ <- get (probeClient context) (probeBase context <> "/app") session <- get (probeClient context) (probeBase context <> "/api/session") assertEqual "runtime unauthenticated session" 303 (probeStatus session) putStrLn "Runtime health semantics passed" verifyBaseline :: ProbeContext -> Session -> IO () verifyBaseline context sessionA = do browsed <- browse context sessionA "" assertEqual "runtime baseline browse" 200 (probeStatus 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` probeBody personalB) wrongLogout <- postWith (probeClient context) defaultRequestOptions { optionCookies = Just (sessionCookies sessionA) , optionHeaders = [ ( "X-CSRF-Token" , "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" ) ] } (probeBase context <> "/logout") assert "runtime baseline accepted wrong logout CSRF" $ probeStatus 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 <- postWith (probeClient context) defaultRequestOptions { optionCookies = Just (sessionCookies sessionA) , optionHeaders = [("X-CSRF-Token", sessionCsrf sessionA)] } (probeBase context <> "/logout") assertEqual "runtime baseline logout" 200 (probeStatus 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" (probeBody rootListing) prefixListing <- browse context sessionB "?root=shared&prefix=runtime" assertContains "shared prefix cache invalidation" "coherence.txt" (probeBody 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` probeBody afterDelete) threadDelay 2000000 browse context sessionB "?root=shared" >>= \response -> assertEqual "cache TTL browse" 200 (probeStatus 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 (probeStatus listing) assertContains "Redis-unavailable browse fixture" "cross-user.txt" (probeBody listing) searched <- browse context session "?root=personal&q=CROSS-USER" assertContains "Redis-unavailable search" "cross-user.txt" (probeBody 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 ProbeResponse -> IO ProbeResponse retryPastThrottle attempts action = do response <- action if attempts > 1 && "\"error\":\"throttle_unavailable\"" `BS.isInfixOf` probeBody response then threadDelay 250000 >> retryPastThrottle (attempts - 1) action else pure response requireSucceeded :: String -> ProbeResponse -> IO () requireSucceeded label response = do assertEqual (label <> " status") 200 (probeStatus response) assertContains label "\"result\":\"succeeded\"" (probeBody response) requireError :: String -> Int -> BS.ByteString -> ProbeResponse -> IO () requireError label status code response = do assertEqual (label <> " status") status (probeStatus response) assert (label <> " body: " <> B8.unpack (probeBody response)) (("\"error\":\"" <> code <> "\"") `BS.isInfixOf` probeBody response)