@@ -2,22 +2,22 @@
22module Servant.QuickCheck.InternalSpec (spec) where
33
44
5−import Control.Concurrent.MVar (newMVar, readMVar, swapMVar)
6−import Control.Exception (SomeException)
7−import Control.Monad (replicateM)
8−import Control.Monad.IO.Class (liftIO)
9−import qualified Data.ByteString as BS
10−import qualified Data.ByteString.Char8 as C
11−import Data.Maybe (fromJust)
5+import Control.Concurrent.MVar (newMVar, readMVar, swapMVar)
6+import Control.Exception (SomeException)
7+import Control.Monad (replicateM)
8+import Control.Monad.IO.Class (liftIO)
9+import qualified Data.ByteString as BS
10+import qualified Data.ByteString.Char8 as C
11+import Data.Maybe (fromJust)
12+import Network.HTTP.Client (path, queryString)
1213import Prelude.Compat
1314import Servant
14−import Test.Hspec (Spec, context, describe, it, shouldBe,
15− shouldContain)
16−import Test.Hspec.Core.Spec (Arg, Example, Result (..),
17− defaultParams, safeEvaluateExample)
18−import Test.QuickCheck.Gen (unGen, generate)
19−import Test.QuickCheck.Random (mkQCGen)
20−import Network.HTTP.Client (queryString, path)
15+import Test.Hspec (Spec, context, describe, it, shouldBe,
16+ shouldContain)
17+import Test.Hspec.Core.Spec (Arg, Example, Result (..),
18+ defaultParams)
19+import Test.QuickCheck.Gen (generate, unGen)
20+import Test.QuickCheck.Random (mkQCGen)
2121
2222
2323#if MIN_VERSION_servant(0,8,0)
@@ -27,8 +27,16 @@ import Servant.API.Internal.Test.ComprehensiveAPI (ComprehensiveAPI,
2727 comprehensiveAPI)
2828#endif
2929
30+#if MIN_VERSION_hspec(2,4,0)
31+import Test.Hspec.Core.Spec (safeEvaluateExample)
32+#else
33+import Control.Exception (try)
34+import Test.Hspec.Core.Spec (evaluateExample)
35+#endif
36+
3037import Servant.QuickCheck
31−import Servant.QuickCheck.Internal (genRequest, runGenRequest, serverDoesntSatisfy)
38+import Servant.QuickCheck.Internal (genRequest, runGenRequest,
39+ serverDoesntSatisfy)
3240
3341
3442spec :: Spec
@@ -53,9 +61,9 @@ serversEqualSpec = describe "serversEqual" $ do
5361
5462 context "when servers are not equal" $ do
5563 it "provides the failing responses in the error message" $ do
56− Right (Failure _ err) <- withServantServer api2 server2 $ \burl1 ->
64+ FailedWith err <- withServantServer api2 server2 $ \burl1 ->
5765 withServantServer api2 server3 $ \burl2 -> do
58− safeEvalExample $ serversEqual api2 burl1 burl2 args bodyEquality
66+ evalExample $ serversEqual api2 burl1 burl2 args bodyEquality
5967 show err `shouldContain` "Server equality failed"
6068 show err `shouldContain` "Body: 1"
6169 show err `shouldContain` "Body: 2"
@@ -81,8 +89,8 @@ serverSatisfiesSpec = describe "serverSatisfies" $ do
8189 context "when predicates are false" $ do
8290
8391 it "fails with informative error messages" $ do
84− Right (Failure _ err) <- withServantServerAndContext api ctx server $ \burl -> do
85− safeEvalExample $ serverSatisfies api burl args (notAllowedContainsAllowHeader <%> mempty)
92+ FailedWith err <- withServantServerAndContext api ctx server $ \burl -> do
93+ evalExample $ serverSatisfies api burl args (notAllowedContainsAllowHeader <%> mempty)
8694 show err `shouldContain` "notAllowedContainsAllowHeader"
8795 show err `shouldContain` "Headers"
8896 show err `shouldContain` "Body"
@@ -92,8 +100,8 @@ onlyJsonObjectSpec :: Spec
92100onlyJsonObjectSpec = describe "onlyJsonObjects" $ do
93101
94102 it "fails correctly" $ do
95− Right (Failure _ err) <- withServantServerAndContext api ctx server $ \burl -> do
96− safeEvalExample $ serverSatisfies (Proxy :: Proxy (Get '[JSON] Int)) burl args
103+ FailedWith err <- withServantServerAndContext api ctx server $ \burl -> do
104+ evalExample $ serverSatisfies (Proxy :: Proxy (Get '[JSON] Int)) burl args
97105 (onlyJsonObjects <%> mempty)
98106 show err `shouldContain` "onlyJsonObjects"
99107
@@ -105,8 +113,8 @@ notLongerThanSpec :: Spec
105113notLongerThanSpec = describe "notLongerThan" $ do
106114
107115 it "fails correctly" $ do
108− Right (Failure _ err) <- withServantServerAndContext api ctx server $ \burl -> do
109− safeEvalExample $ serverSatisfies (Proxy :: Proxy (Get '[JSON] Int)) burl args
116+ FailedWith err <- withServantServerAndContext api ctx server $ \burl -> do
117+ evalExample $ serverSatisfies (Proxy :: Proxy (Get '[JSON] Int)) burl args
110118 (notLongerThan 1 <%> mempty)
111119 show err `shouldContain` "notLongerThan"
112120
@@ -259,10 +267,34 @@ ctx = BasicAuthCheck (const . return $ NoSuchUser) :. EmptyContext
259267------------------------------------------------------------------------------
260268-- Utils
261269------------------------------------------------------------------------------
262−safeEvalExample :: (Example e, Arg e ~ ()) => e -> IO (Either SomeException Result)
263−safeEvalExample e = safeEvaluateExample e defaultParams ($ ()) progCallback
270+evalExample :: (Example e, Arg e ~ ()) => e -> IO EvalResult
271+#if MIN_VERSION_hspec(2,4,0)
272+evalExample e = do
273+ r <- safeEvaluateExample e defaultParams ($ ()) progCallback
274+ case r of
275+ Left err -> return $ AnException err
276+ Right Success -> return $ AllGood
277+ Right (Failure _ reason) -> return $ FailedWith $ show reason
278+ Right (Pending _) -> error "should not happen"
279+ where
280+ progCallback _ = return ()
281+#else
282+evalExample e = do
283+ r <- try $ evaluateExample e defaultParams ($ ()) progCallback
284+ case r of
285+ Left err -> return $ AnException err
286+ Right Success -> return $ AllGood
287+ Right (Fail _ reason) -> return $ FailedWith reason
288+ Right (Pending _) -> error "should not happen"
264289 where
265290 progCallback _ = return ()
291+#endif
292+
293+data EvalResult
294+ = AnException SomeException
295+ | AllGood
296+ | FailedWith String
297+ deriving (Show)
266298
267299
268300args :: Args