diff --git a/test/Servant/QuickCheck/InternalSpec.hs b/test/Servant/QuickCheck/InternalSpec.hs index 8c2197b..19daeb9 100644 --- a/test/Servant/QuickCheck/InternalSpec.hs +++ b/test/Servant/QuickCheck/InternalSpec.hs @@ -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