Add tests for not500 and missing wWWAuthenticate header
This commit is contained in:
parent
8673a776dd
commit
064b6601a7
@ -43,11 +43,13 @@ spec = do
|
||||
serversEqualSpec
|
||||
serverSatisfiesSpec
|
||||
isComprehensiveSpec
|
||||
no500s
|
||||
onlyJsonObjectSpec
|
||||
notLongerThanSpec
|
||||
queryParamsSpec
|
||||
queryFlagsSpec
|
||||
deepPathSpec
|
||||
authServerCheck
|
||||
unbiasedGenerationSpec
|
||||
|
||||
serversEqualSpec :: Spec
|
||||
@ -123,6 +125,15 @@ serverSatisfiesSpec = describe "serverSatisfies" $ do
|
||||
show err `shouldContain` "Body"
|
||||
|
||||
|
||||
no500s :: Spec
|
||||
no500s = describe "no500s" $ do
|
||||
|
||||
it "fails correctly" $ do
|
||||
FailedWith err <- withServantServerAndContext api2 ctx server500fail $ \burl -> do
|
||||
evalExample $ serverSatisfies api2 burl args
|
||||
(not500 <%> mempty)
|
||||
show err `shouldContain` "not500"
|
||||
|
||||
onlyJsonObjectSpec :: Spec
|
||||
onlyJsonObjectSpec = describe "onlyJsonObjects" $ do
|
||||
|
||||
@ -189,12 +200,23 @@ queryFlagsSpec = describe "QueryFlags" $ do
|
||||
qs = C.unpack $ queryString req
|
||||
qs `shouldBe` "one&two"
|
||||
|
||||
|
||||
authServerCheck :: Spec
|
||||
authServerCheck = describe "authenticate endpoints" $ do
|
||||
|
||||
it "authorization failure without WWWAuthenticate header fails correctly" $ do
|
||||
FailedWith err <- withServantServerAndContext api2 ctx authFailServer $ \burl -> do
|
||||
evalExample $ serverSatisfies api2 burl args
|
||||
(unauthorizedContainsWWWAuthenticate <%> mempty)
|
||||
show err `shouldContain` "unauthorizedContainsWWWAuthenticate"
|
||||
|
||||
|
||||
-- Large API Randomness Testing Helper
|
||||
makeRandomRequest :: Proxy LargeAPI -> BaseUrl -> IO Integer
|
||||
makeRandomRequest large burl = do
|
||||
req <- generate $ runGenRequest large
|
||||
pure $ fst . fromJust . C.readInteger . C.drop 1 . path $ req burl
|
||||
|
||||
|
||||
unbiasedGenerationSpec :: Spec
|
||||
unbiasedGenerationSpec = describe "Unbiased Generation of requests" $
|
||||
|
||||
@ -251,14 +273,19 @@ type DeepAPI = "one" :> "two" :> "three":> Get '[JSON] ()
|
||||
deepAPI :: Proxy DeepAPI
|
||||
deepAPI = Proxy
|
||||
|
||||
|
||||
server2 :: IO (Server API2)
|
||||
server2 = return $ return 1
|
||||
|
||||
server3 :: IO (Server API2)
|
||||
server3 = return $ return 2
|
||||
|
||||
server500fail :: IO (Server API2)
|
||||
server500fail = return $ throwError $ err500 { errBody = "BOOM!" }
|
||||
|
||||
authFailServer :: IO (Server API2)
|
||||
authFailServer = return $ throwError $ err401 { errBody = "Login failure but missing header"}
|
||||
|
||||
-- Large API for testing the random generator's randomness
|
||||
largeApi :: Proxy LargeAPI
|
||||
largeApi = Proxy
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user