191 lines
7.8 KiB
Haskell
191 lines
7.8 KiB
Haskell
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)
|