Split host tests by component ownership
This commit is contained in:
parent
68a92662c0
commit
48a5b8a433
1 changed files with 1435 additions and 1309 deletions
424
test/Nuthatch/Test/Http.hs
Normal file
424
test/Nuthatch/Test/Http.hs
Normal file
|
|
@ -0,0 +1,424 @@
|
|||
module Nuthatch.Test.Http
|
||||
( tests
|
||||
) where
|
||||
|
||||
import Control.Monad (forM_)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import qualified Data.Aeson as A
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import Data.IORef (IORef, modifyIORef', newIORef, readIORef, writeIORef)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as TE
|
||||
import Network.HTTP.Types
|
||||
( HeaderName
|
||||
, methodGet
|
||||
, methodPost
|
||||
, status200
|
||||
, status303
|
||||
, status400
|
||||
, status404
|
||||
, status405
|
||||
)
|
||||
import Network.Wai (Request (..), responseLBS)
|
||||
import Network.Wai.Test
|
||||
( SRequest (..)
|
||||
, SResponse (..)
|
||||
, defaultRequest
|
||||
, runSession
|
||||
, setPath
|
||||
, srequest
|
||||
)
|
||||
import Nuthatch.Api
|
||||
import Nuthatch.Config (Config)
|
||||
import Nuthatch.Http.Auth
|
||||
( authenticationHandler
|
||||
, loginResponse
|
||||
)
|
||||
import Nuthatch.Http.Server (utf8Boundary)
|
||||
import Nuthatch.Session (mintSession)
|
||||
import Nuthatch.Test.Config (testConfig)
|
||||
import Nuthatch.Types
|
||||
import Servant
|
||||
import Servant.Server.Experimental.Auth (AuthHandler, mkAuthHandler)
|
||||
import Servant.Types.SourceT (source)
|
||||
import Test.Tasty (TestTree, testGroup)
|
||||
import Test.Tasty.HUnit ((@?=), assertBool, testCase)
|
||||
|
||||
tests :: TestTree
|
||||
tests = testGroup "typed HTTP boundary"
|
||||
[ testCase "Servant selects routes and methods" testRouteSelection
|
||||
, testCase "valid query values reach a typed handler" testValidDecoding
|
||||
, testCase "invalid roots and paths fail before handler execution"
|
||||
testInvalidDomains
|
||||
, testCase "malformed UTF-8 fails before handler execution" testMalformedUtf8
|
||||
, testCase "upload headers and operation ids decode before streaming handler execution"
|
||||
testUploadDecoding
|
||||
, testCase "upload and download bodies use Servant streaming endpoints"
|
||||
testStreamingEndpoints
|
||||
, testCase "operation-specific JSON requests and responses remain distinct"
|
||||
testOperationRepresentations
|
||||
, testCase "operation-specific errors have closed distinct representations" $ do
|
||||
let loginError = A.encode OidcCallbackRejected
|
||||
deleteError = A.encode (DeleteMutationRejected "locked")
|
||||
prefixError = A.encode (DeletePrefixMutationRejected "partial")
|
||||
assertBool "login errors carry the login-specific code"
|
||||
("oidc_callback_rejected" `BS.isInfixOf` BL.toStrict loginError)
|
||||
assertBool "delete errors carry the mutation-specific code"
|
||||
("mutation_rejected" `BS.isInfixOf` BL.toStrict deleteError)
|
||||
assertBool "operation errors must not share one representation"
|
||||
(loginError /= deleteError && deleteError /= prefixError)
|
||||
assertBool "prefix errors carry their operation-specific code"
|
||||
("prefix_mutation_rejected" `BS.isInfixOf` BL.toStrict prefixError)
|
||||
, testCase "production authentication validates cookies and callback emits secure cookies"
|
||||
testAuthenticationBoundary
|
||||
, testCase "only canonical product routes are exposed"
|
||||
testCanonicalProductRoutes
|
||||
, testCase "links derive from the type-level API" $
|
||||
show (linkURI (safeLink api (Proxy :: Proxy HealthEndpoint)))
|
||||
@?= "healthz"
|
||||
]
|
||||
|
||||
testRouteSelection :: IO ()
|
||||
testRouteSelection = do
|
||||
calls <- newIORef 0
|
||||
response <- apiRequest calls methodGet "/healthz" [] ""
|
||||
simpleStatus response @?= status200
|
||||
readIORef calls >>= (@?= 1)
|
||||
writeIORef calls 0
|
||||
wrongMethod <- apiRequest calls methodPost "/healthz" [] ""
|
||||
simpleStatus wrongMethod @?= status405
|
||||
readIORef calls >>= (@?= 0)
|
||||
missing <- apiRequest calls methodGet "/missing" [] ""
|
||||
simpleStatus missing @?= status404
|
||||
readIORef calls >>= (@?= 0)
|
||||
|
||||
testValidDecoding :: IO ()
|
||||
testValidDecoding = do
|
||||
calls <- newIORef 0
|
||||
response <- apiRequest calls methodGet
|
||||
"/api/browse?root=personal&prefix=docs%2Freports&q=quarterly&continuation=next"
|
||||
[]
|
||||
""
|
||||
simpleStatus response @?= status200
|
||||
readIORef calls >>= (@?= 1)
|
||||
|
||||
testInvalidDomains :: IO ()
|
||||
testInvalidDomains = do
|
||||
calls <- newIORef 0
|
||||
invalidRoot <- apiRequest calls methodGet "/api/browse?root=PERSONAL" [] ""
|
||||
simpleStatus invalidRoot @?= status400
|
||||
invalidPath <- apiRequest calls methodGet
|
||||
"/api/browse?prefix=docs%2F..%2Fprivate" [] ""
|
||||
simpleStatus invalidPath @?= status400
|
||||
readIORef calls >>= (@?= 0)
|
||||
|
||||
testMalformedUtf8 :: IO ()
|
||||
testMalformedUtf8 = do
|
||||
calls <- newIORef 0
|
||||
response <- apiRequest calls methodGet "/api/browse?q=%FF" [] ""
|
||||
simpleStatus response @?= status400
|
||||
readIORef calls >>= (@?= 0)
|
||||
|
||||
testUploadDecoding :: IO ()
|
||||
testUploadDecoding = do
|
||||
calls <- newIORef 0
|
||||
let csrf = BS.replicate 43 97
|
||||
headers =
|
||||
[ ("Content-Type", "application/octet-stream")
|
||||
, ("X-Declared-Size", "4")
|
||||
, ("X-Content-SHA256", BS.replicate 64 97)
|
||||
, ("X-CSRF-Token", csrf)
|
||||
]
|
||||
response <- apiRequest calls methodPost
|
||||
"/api/upload?root=personal&path=docs%2Ffile.txt&operation_id=bad%20id"
|
||||
headers
|
||||
"body"
|
||||
simpleStatus response @?= status400
|
||||
invalidSize <- apiRequest calls methodPost
|
||||
"/api/upload?root=personal&path=docs%2Ffile.txt&operation_id=upload-1"
|
||||
(replaceHeader "X-Declared-Size" "zero" headers)
|
||||
"body"
|
||||
simpleStatus invalidSize @?= status400
|
||||
invalidPagination <- apiRequest calls methodGet
|
||||
"/api/browse?continuation=" [] ""
|
||||
simpleStatus invalidPagination @?= status400
|
||||
readIORef calls >>= (@?= 0)
|
||||
|
||||
testStreamingEndpoints :: IO ()
|
||||
testStreamingEndpoints = do
|
||||
calls <- newIORef 0
|
||||
let csrf = BS.replicate 43 97
|
||||
headers =
|
||||
[ ("Content-Type", "application/octet-stream")
|
||||
, ("X-Declared-Size", "4")
|
||||
, ("X-Content-SHA256", BS.replicate 64 97)
|
||||
, ("X-CSRF-Token", csrf)
|
||||
]
|
||||
upload <- apiRequest calls methodPost
|
||||
"/api/upload?root=personal&path=docs%2Ffile.txt&operation_id=upload-1"
|
||||
headers
|
||||
"body"
|
||||
simpleStatus upload @?= status200
|
||||
assertBool "upload advertises the idempotency window"
|
||||
("\"idempotency_window_seconds\":3600"
|
||||
`BS.isInfixOf` BL.toStrict (simpleBody upload))
|
||||
download <- apiRequest calls methodGet
|
||||
"/api/download?root=shared&path=docs%2Ffile.txt"
|
||||
[]
|
||||
""
|
||||
simpleStatus download @?= status200
|
||||
simpleBody download @?= "body"
|
||||
lookup "Content-Disposition" (simpleHeaders download)
|
||||
@?= Just "attachment; filename=\"file.txt\""
|
||||
lookup "X-Content-Type-Options" (simpleHeaders download)
|
||||
@?= Just "nosniff"
|
||||
readIORef calls >>= (@?= 2)
|
||||
|
||||
testOperationRepresentations :: IO ()
|
||||
testOperationRepresentations = do
|
||||
calls <- newIORef 0
|
||||
login <- apiRequest calls methodGet "/login" [] ""
|
||||
simpleStatus login @?= status303
|
||||
lookup "Location" (simpleHeaders login)
|
||||
@?= Just "https://issuer.example/authorize"
|
||||
callback <- apiRequest calls methodGet
|
||||
"/oidc/callback?code=code&state=state"
|
||||
[("Cookie", "nuthatch_oidc=transaction")]
|
||||
""
|
||||
simpleStatus callback @?= status303
|
||||
wrongLoginMethod <- apiRequest calls methodPost "/login" [] ""
|
||||
simpleStatus wrongLoginMethod @?= status405
|
||||
deletion <- apiRequest calls methodPost
|
||||
"/api/delete"
|
||||
[("Content-Type", "application/json")]
|
||||
"{\"root\":\"shared\",\"path\":\"docs/file.txt\",\"operation_id\":\"delete-1\",\"csrf\":\"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\"}"
|
||||
simpleStatus deletion @?= status200
|
||||
assertBool "delete response must carry a mutation result"
|
||||
("succeeded" `BS.isInfixOf` BL.toStrict (simpleBody deletion))
|
||||
assertBool "delete advertises the idempotency window"
|
||||
("\"idempotency_window_seconds\":3600"
|
||||
`BS.isInfixOf` BL.toStrict (simpleBody deletion))
|
||||
malformed <- apiRequest calls methodPost
|
||||
"/api/delete"
|
||||
[("Content-Type", "application/json")]
|
||||
"{\"root\":\"shared\",\"path\":\"../escape\"}"
|
||||
simpleStatus malformed @?= status400
|
||||
readIORef calls >>= (@?= 3)
|
||||
|
||||
replaceHeader
|
||||
:: HeaderName
|
||||
-> BS.ByteString
|
||||
-> [(HeaderName, BS.ByteString)]
|
||||
-> [(HeaderName, BS.ByteString)]
|
||||
replaceHeader name value =
|
||||
map $ \(headerName, headerValue) ->
|
||||
if headerName == name
|
||||
then (headerName, value)
|
||||
else (headerName, headerValue)
|
||||
|
||||
apiRequest
|
||||
:: IORef Int
|
||||
-> BS.ByteString
|
||||
-> BS.ByteString
|
||||
-> [(HeaderName, BS.ByteString)]
|
||||
-> BL.ByteString
|
||||
-> IO SResponse
|
||||
apiRequest calls method path headers body =
|
||||
apiRequestWith (typedTestApplication calls) method path headers body
|
||||
|
||||
apiRequestWith
|
||||
:: Application
|
||||
-> BS.ByteString
|
||||
-> BS.ByteString
|
||||
-> [(HeaderName, BS.ByteString)]
|
||||
-> BL.ByteString
|
||||
-> IO SResponse
|
||||
apiRequestWith app method path headers body =
|
||||
runSession
|
||||
(srequest
|
||||
(SRequest
|
||||
(setPath defaultRequest
|
||||
{ requestMethod = method
|
||||
, requestHeaders = headers
|
||||
}
|
||||
path)
|
||||
body))
|
||||
app
|
||||
|
||||
typedTestApplication :: IORef Int -> Application
|
||||
typedTestApplication calls =
|
||||
utf8Boundary $
|
||||
serveWithContext api (auth :. EmptyContext) (typedTestServer calls)
|
||||
where
|
||||
auth :: AuthHandler Request SessionContext
|
||||
auth = mkAuthHandler $ \_ -> pure SessionContext
|
||||
{ sessionUser = SessionUser
|
||||
{ suIssuer = "issuer"
|
||||
, suSubject = "subject"
|
||||
, suUserId = UserId "user"
|
||||
, suDisplay = Nothing
|
||||
}
|
||||
, sessionCsrf = Just
|
||||
(CsrfToken "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa")
|
||||
}
|
||||
|
||||
typedTestServer :: IORef Int -> Server Api
|
||||
typedTestServer calls =
|
||||
counted (HealthResponse True)
|
||||
:<|> counted (ReadyResponse True)
|
||||
:<|> (\_ -> counted (addHeader "default-src 'none'" (HtmlPage "app")))
|
||||
:<|> (\_ -> Tagged $ \_ sendResponse ->
|
||||
sendResponse (responseLBS status404 [] ""))
|
||||
:<|> counted
|
||||
(addHeader "transaction=cookie"
|
||||
(addHeader "https://issuer.example/authorize" NoContent))
|
||||
:<|> (\_ _ _ -> counted
|
||||
(addHeader "session=cookie"
|
||||
(addHeader "csrf=cookie"
|
||||
(addHeader "transaction=expired"
|
||||
(addHeader "/app" NoContent)))))
|
||||
:<|> (\_ _ -> counted
|
||||
(addHeader "session=expired"
|
||||
(addHeader "csrf=expired"
|
||||
(addHeader "transaction=expired" NoContent))))
|
||||
:<|>
|
||||
( (\session -> counted SessionResponse
|
||||
{ sessionResponseUserId = suUserId (sessionUser session)
|
||||
, sessionResponseDisplay = Nothing
|
||||
, sessionResponseCsrf =
|
||||
CsrfToken "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
|
||||
})
|
||||
:<|> (\_ _ _ _ _ -> counted emptyBrowse)
|
||||
:<|> (\_ _ _ _ -> counted downloadResponse)
|
||||
:<|> (\_ _ _ operation _ _ _ _ -> counted UploadResponse
|
||||
{ uploadResponseOperationId = operation
|
||||
, uploadResponseResult = MutationSucceeded
|
||||
, uploadResponseIdempotencyWindowSeconds = 3600
|
||||
})
|
||||
:<|> (\_ request -> counted DeleteResponse
|
||||
{ deleteResponseOperationId = deleteOperationId request
|
||||
, deleteResponseResult = MutationSucceeded
|
||||
, deleteResponseIdempotencyWindowSeconds = 3600
|
||||
})
|
||||
:<|> (\_ _ _ _ -> counted DeletePlanResponse
|
||||
{ deletePlanPaths = []
|
||||
, deletePlanContinuation = Nothing
|
||||
})
|
||||
:<|> (\_ _ -> counted (DeleteBatchResponse []))
|
||||
)
|
||||
where
|
||||
counted :: a -> Handler a
|
||||
counted value = liftIO (modifyIORef' calls (+ 1)) >> pure value
|
||||
emptyBrowse =
|
||||
BrowseResponse
|
||||
{ browseEntries = []
|
||||
, browseContinuation = Nothing
|
||||
, browsePartial = False
|
||||
}
|
||||
downloadResponse =
|
||||
addHeader "attachment; filename=\"file.txt\"" $
|
||||
addHeader "nosniff" $
|
||||
addHeader "sandbox" $
|
||||
addHeader 4 (source ["body"])
|
||||
|
||||
testAuthenticationBoundary :: IO ()
|
||||
testAuthenticationBoundary = do
|
||||
tokenResult <- mintSession testConfig "issuer" "subject" Nothing
|
||||
token <- either (fail . T.unpack) pure tokenResult
|
||||
let csrf = CsrfToken "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
|
||||
responseHeaders = getHeaders
|
||||
(loginResponse testConfig token csrf)
|
||||
cookieHeaders =
|
||||
[ value
|
||||
| (name, value) <- responseHeaders
|
||||
, name == "Set-Cookie"
|
||||
]
|
||||
lookup "Location" responseHeaders @?= Just "/app"
|
||||
length cookieHeaders @?= 3
|
||||
assertBool "login sets the session cookie"
|
||||
(any ("nuthatch_session=" `BS.isPrefixOf`) cookieHeaders)
|
||||
assertBool "login sets the CSRF cookie"
|
||||
(any ("nuthatch_csrf=" `BS.isPrefixOf`) cookieHeaders)
|
||||
assertBool "cookies are secure and same-site"
|
||||
(all ("Secure" `BS.isInfixOf`) cookieHeaders
|
||||
&& all ("SameSite=Lax" `BS.isInfixOf`) cookieHeaders)
|
||||
assertBool "cookies are host-only"
|
||||
(all (not . ("Domain=" `BS.isInfixOf`)) cookieHeaders)
|
||||
assertBool "session and CSRF cookies use the root path"
|
||||
(length (filter ("Path=/;" `BS.isInfixOf`) cookieHeaders) == 2)
|
||||
assertBool "the transaction cookie uses the callback path"
|
||||
(any ("Path=/oidc/callback;" `BS.isInfixOf`) cookieHeaders)
|
||||
assertBool "session and transaction cookies are HTTP-only"
|
||||
(length (filter ("HttpOnly" `BS.isInfixOf`) cookieHeaders) == 2)
|
||||
|
||||
calls <- newIORef 0
|
||||
let app = productionAuthTestApplication testConfig calls
|
||||
cookie =
|
||||
"nuthatch_session=" <> TE.encodeUtf8 (unSessionToken token)
|
||||
<> "; nuthatch_csrf=" <> TE.encodeUtf8 (unCsrfToken csrf)
|
||||
authenticated <- apiRequestWith app methodGet
|
||||
"/api/browse?root=personal"
|
||||
[("Cookie", cookie)]
|
||||
""
|
||||
simpleStatus authenticated @?= status200
|
||||
readIORef calls >>= (@?= 1)
|
||||
|
||||
writeIORef calls 0
|
||||
malformed <- apiRequestWith app methodGet
|
||||
"/api/browse?root=personal"
|
||||
[("Cookie", "nuthatch_session=" <> BS.singleton 255
|
||||
<> "; nuthatch_csrf=" <> TE.encodeUtf8 (unCsrfToken csrf))]
|
||||
""
|
||||
simpleStatus malformed @?= status400
|
||||
readIORef calls >>= (@?= 0)
|
||||
|
||||
malformedGrammar <- apiRequestWith app methodGet
|
||||
"/api/browse?root=personal"
|
||||
[("Cookie", "nuthatch_session")]
|
||||
""
|
||||
simpleStatus malformedGrammar @?= status400
|
||||
readIORef calls >>= (@?= 0)
|
||||
|
||||
let tamperedToken =
|
||||
case T.unsnoc (unSessionToken token) of
|
||||
Just (prefix, final)
|
||||
| final == 'a' -> prefix <> "b"
|
||||
| otherwise -> prefix <> "a"
|
||||
Nothing -> "invalid"
|
||||
tampered <- apiRequestWith app methodGet
|
||||
"/api/browse?root=personal"
|
||||
[("Cookie", "nuthatch_session=" <> TE.encodeUtf8 tamperedToken)]
|
||||
""
|
||||
simpleStatus tampered @?= status303
|
||||
readIORef calls >>= (@?= 0)
|
||||
|
||||
missingCsrf <- apiRequestWith app methodGet
|
||||
"/api/browse?root=personal"
|
||||
[("Cookie", "nuthatch_session=" <> TE.encodeUtf8 (unSessionToken token))]
|
||||
""
|
||||
simpleStatus missingCsrf @?= status200
|
||||
readIORef calls >>= (@?= 1)
|
||||
|
||||
testCanonicalProductRoutes :: IO ()
|
||||
testCanonicalProductRoutes = do
|
||||
calls <- newIORef 0
|
||||
forM_
|
||||
[ (methodGet, "/")
|
||||
, (methodGet, "/nuthatch.js")
|
||||
, (methodGet, "/download?root=personal&path=file")
|
||||
, (methodPost, "/upload")
|
||||
, (methodPost, "/delete")
|
||||
, (methodPost, "/delete-prefix")
|
||||
] $ \(method, path) -> do
|
||||
response <- apiRequest calls method path [] ""
|
||||
simpleStatus response @?= status404
|
||||
readIORef calls >>= (@?= 0)
|
||||
|
||||
productionAuthTestApplication :: Config -> IORef Int -> Application
|
||||
productionAuthTestApplication cfg calls =
|
||||
utf8Boundary $
|
||||
serveWithContext
|
||||
api
|
||||
(authenticationHandler cfg :. EmptyContext)
|
||||
(typedTestServer calls)
|
||||
Loading…
Reference in a new issue