Add tests for not500 and missing wWWAuthenticate header

This commit is contained in:
Erik Aker 2017-10-21 15:12:16 -07:00
parent 8673a776dd
commit 064b6601a7

View File

@ -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