Split kind tests into component-owned probes
This commit is contained in:
parent
b3c0f6d58a
commit
691ad92e30
1 changed files with 4269 additions and 3108 deletions
373
test/ProductProbe.hs
Normal file
373
test/ProductProbe.hs
Normal file
|
|
@ -0,0 +1,373 @@
|
|||
module Main (main) where
|
||||
|
||||
import Data.Aeson (Value (..), eitherDecodeStrict')
|
||||
import qualified Data.Aeson.Key as Key
|
||||
import qualified Data.Aeson.KeyMap as KeyMap
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Char8 as B8
|
||||
import qualified Data.Text as Text
|
||||
import Nuthatch.Probe.Assert
|
||||
import Nuthatch.Probe.Curl
|
||||
import Nuthatch.Probe.Oidc
|
||||
import Nuthatch.Probe.ProductClient
|
||||
import System.Environment (getArgs)
|
||||
import System.IO.Temp (withSystemTempDirectory)
|
||||
|
||||
main :: IO ()
|
||||
main =
|
||||
withSystemTempDirectory "nuthatch-product-probe" $ \directory -> do
|
||||
context <- newProbeContext directory
|
||||
user <- requireEnv "NUTHATCH_OIDC_USER_A"
|
||||
session <- login context False user "product"
|
||||
getArgs >>= \case
|
||||
["verify"] -> verifyProduct context session
|
||||
["timeout"] -> verifyTimeout context session
|
||||
_ -> fail "expected verify or timeout mode"
|
||||
|
||||
verifyTimeout :: ProbeContext -> Session -> IO ()
|
||||
verifyTimeout context session = do
|
||||
response <- curl
|
||||
[ "--get"
|
||||
, "--cookie", sessionCookies session
|
||||
, "--data-urlencode", "root=personal"
|
||||
, "--data-urlencode", "q=timeout-probe"
|
||||
, probeBase context <> "/api/browse"
|
||||
]
|
||||
assertEqual "timed search status" 200 (curlStatus response)
|
||||
assertContains "timed search bound" "\"partial\":true" (curlBody response)
|
||||
putStrLn "Timed search bound passed"
|
||||
|
||||
verifyProduct :: ProbeContext -> Session -> IO ()
|
||||
verifyProduct context session = do
|
||||
verifyApplicationAssets context session
|
||||
verifyPaginationAndSearch context session
|
||||
verifyCanonicalPaths context session
|
||||
verifySafeDownload context session
|
||||
verifyRecursiveDelete context session
|
||||
putStrLn "Product behavior passed"
|
||||
|
||||
verifyApplicationAssets :: ProbeContext -> Session -> IO ()
|
||||
verifyApplicationAssets context session = do
|
||||
sessionResponse <- curl
|
||||
[ "--cookie", sessionCookies session
|
||||
, probeBase context <> "/api/session"
|
||||
]
|
||||
assertEqual "session endpoint status" 200 (curlStatus sessionResponse)
|
||||
assertContains "session user" "\"user_id\":" (curlBody sessionResponse)
|
||||
assertContains "session CSRF"
|
||||
("\"csrf\":\"" <> sessionCsrf session <> "\"")
|
||||
(curlBody sessionResponse)
|
||||
application <- curl
|
||||
[ "--cookie", sessionCookies session
|
||||
, probeBase context <> "/app"
|
||||
]
|
||||
assertEqual "application status" 200 (curlStatus application)
|
||||
csp <- maybe (fail "application omitted CSP") pure $
|
||||
headerValue "content-security-policy" application
|
||||
mapM_
|
||||
(\directive ->
|
||||
assertContains ("application CSP omitted " <> B8.unpack directive)
|
||||
directive
|
||||
csp)
|
||||
["default-src 'none'", "script-src 'self'", "frame-ancestors 'none'"]
|
||||
asset <- between "src=\"/assets/" "\"" (B8.unpack (curlBody application))
|
||||
javascript <- curl
|
||||
[ "--cookie", sessionCookies session
|
||||
, probeBase context <> "/assets/" <> asset
|
||||
]
|
||||
assertEqual "asset status" 200 (curlStatus javascript)
|
||||
assertContains "asset content type" "javascript" $
|
||||
maybe BS.empty id (headerValue "content-type" javascript)
|
||||
assertEqual "asset nosniff"
|
||||
(Just "nosniff")
|
||||
(headerValue "x-content-type-options" javascript)
|
||||
let visible = curlBody application <> curlBody javascript
|
||||
mapM_
|
||||
(\value ->
|
||||
assert ("browser artifact exposed " <> value) $
|
||||
not (B8.pack value `BS.isInfixOf` visible))
|
||||
[ "NUTHATCH_S3"
|
||||
, "AWS_ACCESS_KEY"
|
||||
, "AWS_SECRET_ACCESS_KEY"
|
||||
, "client_secret"
|
||||
]
|
||||
mapM_
|
||||
(\marker ->
|
||||
assertContains ("asset omitted " <> marker)
|
||||
(B8.pack marker)
|
||||
(curlBody javascript))
|
||||
[ "Drop a file here"
|
||||
, "Shared root"
|
||||
, "Retry same upload"
|
||||
, "Retry same delete"
|
||||
, "nuthatch-recursive-delete"
|
||||
, "URLSearchParams"
|
||||
]
|
||||
unauthenticatedApp <- curl [probeBase context <> "/app"]
|
||||
assertEqual "unauthenticated application" 303 (curlStatus unauthenticatedApp)
|
||||
unauthenticatedAsset <- curl [probeBase context <> "/assets/" <> asset]
|
||||
assertEqual "unauthenticated asset" 303 (curlStatus unauthenticatedAsset)
|
||||
|
||||
verifyPaginationAndSearch :: ProbeContext -> Session -> IO ()
|
||||
verifyPaginationAndSearch context session = do
|
||||
uploadSucceeded context session "product-browse/Alpha.txt"
|
||||
"81000000-0000-4000-8000-000000000001" "alpha"
|
||||
replay <- upload context session "personal" "product-browse/Alpha.txt"
|
||||
"81000000-0000-4000-8000-000000000001" "alpha"
|
||||
requireSucceeded "product upload replay" replay
|
||||
uploadSucceeded context session "product-browse/beta.txt"
|
||||
"81000000-0000-4000-8000-000000000002" "beta"
|
||||
uploadSucceeded context session "product-browse/gamma.txt"
|
||||
"81000000-0000-4000-8000-000000000003" "gamma"
|
||||
firstPage <- curl
|
||||
[ "--get"
|
||||
, "--cookie", sessionCookies session
|
||||
, "--data-urlencode", "root=personal"
|
||||
, "--data-urlencode", "prefix=product-browse"
|
||||
, probeBase context <> "/api/browse"
|
||||
]
|
||||
requireStatus "first browse page" 200 firstPage
|
||||
assertContains "first page Alpha"
|
||||
"\"path\":\"product-browse/Alpha.txt\""
|
||||
(curlBody firstPage)
|
||||
assertContains "first page beta"
|
||||
"\"path\":\"product-browse/beta.txt\""
|
||||
(curlBody firstPage)
|
||||
assert "first page exceeded configured size" $
|
||||
not ("product-browse/gamma.txt" `BS.isInfixOf` curlBody firstPage)
|
||||
continuation <- stringField "continuation" (curlBody firstPage)
|
||||
secondPage <- curl
|
||||
[ "--get"
|
||||
, "--cookie", sessionCookies session
|
||||
, "--data-urlencode", "root=personal"
|
||||
, "--data-urlencode", "prefix=product-browse"
|
||||
, "--data-urlencode", "continuation=" <> continuation
|
||||
, probeBase context <> "/api/browse"
|
||||
]
|
||||
assertContains "second browse page"
|
||||
"\"path\":\"product-browse/gamma.txt\""
|
||||
(curlBody secondPage)
|
||||
mapM_
|
||||
(\(path, operationId, body) ->
|
||||
uploadSucceeded context session path operationId body)
|
||||
[ ("000-Needle-A.txt", "81000000-0000-4000-8000-000000000004", "one")
|
||||
, ("001-needle-b.txt", "81000000-0000-4000-8000-000000000005", "two")
|
||||
, ("002-filler.txt", "81000000-0000-4000-8000-000000000006", "three")
|
||||
, ("003-needle-after-bound.txt", "81000000-0000-4000-8000-000000000007", "four")
|
||||
]
|
||||
searched <- curl
|
||||
[ "--get"
|
||||
, "--cookie", sessionCookies session
|
||||
, "--data-urlencode", "root=personal"
|
||||
, "--data-urlencode", "q=NEEDLE"
|
||||
, probeBase context <> "/api/browse"
|
||||
]
|
||||
mapM_
|
||||
(\value -> assertContains "bounded case-insensitive search" value (curlBody searched))
|
||||
[ "\"path\":\"000-Needle-A.txt\""
|
||||
, "\"path\":\"001-needle-b.txt\""
|
||||
, "\"partial\":true"
|
||||
]
|
||||
assert "search crossed the configured scan bound" $
|
||||
not ("003-needle-after-bound.txt" `BS.isInfixOf` curlBody searched)
|
||||
|
||||
verifyCanonicalPaths :: ProbeContext -> Session -> IO ()
|
||||
verifyCanonicalPaths context session = do
|
||||
mapM_
|
||||
(\url -> curl ["--cookie", sessionCookies session, url] >>=
|
||||
requireStatus "non-canonical path" 400)
|
||||
[ probeBase context <> "/api/browse?root=Personal"
|
||||
, probeBase context <> "/api/browse?root=personal&prefix=a//b"
|
||||
, probeBase context <> "/api/download?root=personal&path=./file"
|
||||
]
|
||||
decomposed <- curl
|
||||
[ "--cookie", sessionCookies session
|
||||
, probeBase context
|
||||
<> "/api/download?root=personal&path=cafe%CC%81.txt"
|
||||
]
|
||||
requireStatus "non-NFC path" 400 decomposed
|
||||
uploadSucceeded context session "encoded%2Fname.txt"
|
||||
"81000000-0000-4000-8000-000000000008" "encoded"
|
||||
encoded <- curl
|
||||
[ "--cookie", sessionCookies session
|
||||
, probeBase context
|
||||
<> "/api/download?root=personal&path=encoded%252Fname.txt"
|
||||
]
|
||||
assertEqual "encoded path body" "encoded" (curlBody encoded)
|
||||
uploadSucceeded context session "café.txt"
|
||||
"81000000-0000-4000-8000-000000000014" "unicode"
|
||||
unicode <- download context session "personal" "café.txt"
|
||||
assertEqual "Unicode path body" "unicode" (curlBody unicode)
|
||||
assertContains "Unicode filename"
|
||||
"filename*=UTF-8''caf%C3%A9.txt"
|
||||
(maybe BS.empty id (headerValue "content-disposition" unicode))
|
||||
|
||||
verifySafeDownload :: ProbeContext -> Session -> IO ()
|
||||
verifySafeDownload context session = do
|
||||
let svg = "<svg onload=\"alert(1)\"></svg>"
|
||||
uploadSucceeded context session "active.svg"
|
||||
"81000000-0000-4000-8000-000000000009" svg
|
||||
ranged <- curl
|
||||
[ "--cookie", sessionCookies session
|
||||
, "--header", "Range: bytes=0-1"
|
||||
, probeBase context <> "/api/download?root=personal&path=active.svg"
|
||||
]
|
||||
requireStatus "unsupported range" 416 ranged
|
||||
assertContains "range error"
|
||||
"\"error\":\"range_not_supported\""
|
||||
(curlBody ranged)
|
||||
downloaded <- download context session "personal" "active.svg"
|
||||
requireStatus "safe download" 200 downloaded
|
||||
let disposition =
|
||||
maybe BS.empty id (headerValue "content-disposition" downloaded)
|
||||
assertContains "download attachment" "attachment;" disposition
|
||||
assertContains "download filename" "filename*=UTF-8''active.svg" disposition
|
||||
assertEqual "download nosniff"
|
||||
(Just "nosniff")
|
||||
(headerValue "x-content-type-options" downloaded)
|
||||
assertContains "download sandbox"
|
||||
"sandbox"
|
||||
(maybe BS.empty id (headerValue "content-security-policy" downloaded))
|
||||
assertEqual "download body" svg (curlBody downloaded)
|
||||
|
||||
verifyRecursiveDelete :: ProbeContext -> Session -> IO ()
|
||||
verifyRecursiveDelete context session = do
|
||||
mapM_
|
||||
(\(path, operationId, body) ->
|
||||
uploadSucceeded context session path operationId body)
|
||||
[ ("delete-tree/a.txt", "81000000-0000-4000-8000-000000000010", "a")
|
||||
, ("delete-tree/b.txt", "81000000-0000-4000-8000-000000000011", "b")
|
||||
, ("delete-tree/c.txt", "81000000-0000-4000-8000-000000000012", "c")
|
||||
]
|
||||
planned <- deletePlan context session
|
||||
assertContains "first delete plan"
|
||||
"\"paths\":[\"delete-tree/a.txt\",\"delete-tree/b.txt\"]"
|
||||
(curlBody planned)
|
||||
assert "first delete plan omitted continuation" $
|
||||
not ("\"continuation\":null" `BS.isInfixOf` curlBody planned)
|
||||
let firstBatch =
|
||||
"{\"root\":\"personal\",\"csrf\":\""
|
||||
<> B8.unpack (sessionCsrf session)
|
||||
<> "\",\"items\":["
|
||||
<> "{\"path\":\"delete-tree/a.txt\",\"operation_id\":"
|
||||
<> "\"82000000-0000-4000-8000-000000000001\"},"
|
||||
<> "{\"path\":\"delete-tree/b.txt\",\"operation_id\":"
|
||||
<> "\"82000000-0000-4000-8000-000000000002\"}]}"
|
||||
first <- deleteBatch context session firstBatch
|
||||
requireBatchSucceeded "first delete batch" first
|
||||
replay <- deleteBatch context session firstBatch
|
||||
requireBatchSucceeded "delete batch replay" replay
|
||||
uploadSucceeded context session "delete-tree/d-concurrent.txt"
|
||||
"81000000-0000-4000-8000-000000000013" "d"
|
||||
restarted <- deletePlan context session
|
||||
assertContains "restarted delete plan"
|
||||
"\"paths\":[\"delete-tree/c.txt\",\"delete-tree/d-concurrent.txt\"]"
|
||||
(curlBody restarted)
|
||||
let secondBatch =
|
||||
"{\"root\":\"personal\",\"csrf\":\""
|
||||
<> B8.unpack (sessionCsrf session)
|
||||
<> "\",\"items\":["
|
||||
<> "{\"path\":\"delete-tree/c.txt\",\"operation_id\":"
|
||||
<> "\"82000000-0000-4000-8000-000000000003\"},"
|
||||
<> "{\"path\":\"delete-tree/d-concurrent.txt\",\"operation_id\":"
|
||||
<> "\"82000000-0000-4000-8000-000000000004\"}]}"
|
||||
second <- deleteBatch context session secondBatch
|
||||
requireBatchSucceeded "second delete batch" second
|
||||
empty <- deletePlan context session
|
||||
assertContains "empty delete plan" "\"paths\":[]" (curlBody empty)
|
||||
assertContains "empty delete continuation"
|
||||
"\"continuation\":null"
|
||||
(curlBody empty)
|
||||
|
||||
deletePlan :: ProbeContext -> Session -> IO CurlResponse
|
||||
deletePlan context session =
|
||||
curl
|
||||
[ "--get"
|
||||
, "--cookie", sessionCookies session
|
||||
, "--data-urlencode", "root=personal"
|
||||
, "--data-urlencode", "path=delete-tree"
|
||||
, probeBase context <> "/api/delete-plan"
|
||||
]
|
||||
|
||||
deleteBatch
|
||||
:: ProbeContext
|
||||
-> Session
|
||||
-> String
|
||||
-> IO CurlResponse
|
||||
deleteBatch context session body =
|
||||
curl
|
||||
[ "--cookie", sessionCookies session
|
||||
, "--header", "Content-Type: application/json"
|
||||
, "--data", body
|
||||
, probeBase context <> "/api/delete-batch"
|
||||
]
|
||||
|
||||
requireBatchSucceeded :: String -> CurlResponse -> IO ()
|
||||
requireBatchSucceeded label response = do
|
||||
requireStatus label 200 response
|
||||
assertEqual label 2 $
|
||||
countOccurrences "\"result\":\"succeeded\"" (curlBody response)
|
||||
|
||||
uploadSucceeded
|
||||
:: ProbeContext
|
||||
-> Session
|
||||
-> String
|
||||
-> String
|
||||
-> BS.ByteString
|
||||
-> IO ()
|
||||
uploadSucceeded context session path operationId body =
|
||||
upload context session "personal" path operationId body >>=
|
||||
requireSucceeded ("upload " <> path)
|
||||
|
||||
requireSucceeded :: String -> CurlResponse -> IO ()
|
||||
requireSucceeded label response = do
|
||||
requireStatus label 200 response
|
||||
assertContains label "\"result\":\"succeeded\"" (curlBody response)
|
||||
|
||||
requireStatus :: String -> Int -> CurlResponse -> IO ()
|
||||
requireStatus label expected response =
|
||||
assertEqual (label <> " status") expected (curlStatus response)
|
||||
|
||||
stringField :: String -> BS.ByteString -> IO String
|
||||
stringField name bytes =
|
||||
case eitherDecodeStrict' bytes of
|
||||
Right (Object object) ->
|
||||
case KeyMap.lookup (Key.fromString name) object of
|
||||
Just (String value) -> pure (Text.unpack value)
|
||||
_ -> fail ("JSON omitted string field " <> name)
|
||||
Right _ -> fail "expected JSON object"
|
||||
Left reason -> fail ("invalid JSON: " <> reason)
|
||||
|
||||
between :: String -> String -> String -> IO String
|
||||
between start end value =
|
||||
case dropUntil start value of
|
||||
Nothing -> fail ("value omitted " <> start)
|
||||
Just afterStart ->
|
||||
case takeUntil end afterStart of
|
||||
Nothing -> fail ("value omitted " <> end)
|
||||
Just result -> pure result
|
||||
|
||||
dropUntil :: String -> String -> Maybe String
|
||||
dropUntil needle value
|
||||
| needle `prefixOf` value = Just (drop (length needle) value)
|
||||
dropUntil _ [] = Nothing
|
||||
dropUntil needle (_ : rest) = dropUntil needle rest
|
||||
|
||||
takeUntil :: String -> String -> Maybe String
|
||||
takeUntil needle = go []
|
||||
where
|
||||
go prefix value
|
||||
| needle `prefixOf` value = Just (reverse prefix)
|
||||
go _ [] = Nothing
|
||||
go prefix (next : rest) = go (next : prefix) rest
|
||||
|
||||
prefixOf :: String -> String -> Bool
|
||||
prefixOf prefix value =
|
||||
take (length prefix) value == prefix
|
||||
|
||||
countOccurrences :: BS.ByteString -> BS.ByteString -> Int
|
||||
countOccurrences needle input
|
||||
| BS.null input = 0
|
||||
| needle `BS.isPrefixOf` input =
|
||||
1 + countOccurrences needle (BS.drop (BS.length needle) input)
|
||||
| otherwise = countOccurrences needle (BS.drop 1 input)
|
||||
Loading…
Reference in a new issue