git.iko.soy/servant-quickcheck
on master help sign in
Documentation improvements
commit76e3b8e7ec42c66c0488e19eaa45b353df7d05c9 authorJulian K. Arni <jkarni@gmail.com> dateSat 23 Apr 2016, 22:36 (11 years ago) parent0bb6346
4 files changed+53−30
compare with master
unifiedsplit
src/Servant/QuickCheck.hs+20−17 src/Servant/QuickCheck/Internal/Equality.hs+2−4 src/Servant/QuickCheck/Internal/Predicates.hs+6−1 src/Servant/QuickCheck/Internal/QuickCheck.hs+25−8
src/Servant/QuickCheck.hs+20−17
@@ -6,16 +6,6 @@
66-- tested itself need not be implemented with @servant-server@ (or indeed,
77-- written in Haskell).
88--
9−-- /N.B./ The examples given here assume the following setup:
10−--
11−-- > import Servant
12−-- > import Servant.QuickCheck
13−-- > import Test.Hspec
14−-- >
15−-- > type API = ReqBody '[JSON] Int :> Post '[JSON] String
16−-- >
17−-- > api :: Proxy API
18−-- > api = Proxy
199module Servant.QuickCheck
2010 (
2111
@@ -24,19 +14,32 @@ module Servant.QuickCheck
2414 -- | Helpers to setup and teardown @servant@ servers during tests.
2515 withServantServer
2616
27− , serversEqual
28− , serverSatisfies
2917
30− -- * Response equality
18+ -- * Equality testing
19+ , serversEqual
20+ -- ** Response equality
21+ -- | Often the normal equality of responses is not what we want. For example,
22+ -- if responses contain a @Date@ header with the time of the response,
23+ -- responses will fail to be equal even though they morally are. This datatype
24+ -- represents other means of checking equality
25+ -- *** Useful @ResponseEquality@s
3126 , bodyEquality
3227 , allEquality
33− , ResponseEquality(getResponseEquality)
28+ -- ** Response equality type
29+ , ResponseEquality(..)
3430
35− -- * Predicates
36− , (<%>)
37− , Predicates
31+ -- * Property testing
32+ , serverSatisfies
33+ -- ** Predicates
34+ -- *** Useful predicates
3835 , not500
3936 , onlyJsonObjects
37+ , notAllowedContainsAllowHeader
38+ -- *** Predicate utilities and types
39+ , (<%>)
40+ , Predicates
41+ , ResponsePredicate(..)
42+ , RequestPredicate(..)
4043
4144 -- ** Re-exports
4245 , BaseUrl(..)
src/Servant/QuickCheck/Internal/Equality.hs+2−4
@@ -3,10 +3,6 @@ module Servant.QuickCheck.Internal.Equality where
33import Network.HTTP.Client
44import Data.Function (on)
55
6−-- | Often the normal equality of responses is not what we want. For example,
7−-- if responses contain a @Date@ header with the time of the response,
8−-- responses will fail to be equal even though they morally are. This datatype
9−-- represents other means of checking equality
106newtype ResponseEquality b
117 = ResponseEquality { getResponseEquality :: Response b -> Response b -> Bool }
128
@@ -15,8 +11,10 @@ instance Monoid (ResponseEquality b) where
1511 ResponseEquality a `mappend` ResponseEquality b = ResponseEquality $ \x y ->
1612 a x y && b x y
1713
14+-- | Use `Eq` instance for `Response`
1815allEquality :: Eq b => ResponseEquality b
1916allEquality = ResponseEquality (==)
2017
18+-- | ByteString `Eq` instance over the response body.
2119bodyEquality :: Eq b => ResponseEquality b
2220bodyEquality = ResponseEquality ((==) `on` responseBody)
src/Servant/QuickCheck/Internal/Predicates.hs+6−1
@@ -229,9 +229,14 @@ instance JoinPreds (ResponsePredicate Text Bool) where
229229 where go = let p' = first return p
230230 in fmap (\z -> if z then [] else respPredName p') p'
231231
232−infixr 6 <%>
232+
233+-- | Adds a new predicate (either `ResponsePredicate` or `RequestPredicate`) to
234+-- the existing predicates.
235+--
236+-- > not500 <%> onlyJsonObjects <%> empty
233237(<%>) :: JoinPreds a => a -> Predicates [Text] [Text] -> Predicates [Text] [Text]
234238(<%>) = joinPreds
239+infixr 6 <%>
235240
236241finishPredicates :: Predicates [Text] [Text] -> Request -> Manager -> IO [Text]
237242finishPredicates p req mgr = do
src/Servant/QuickCheck/Internal/QuickCheck.hs+25−8
@@ -1,19 +1,20 @@
11-- | This module contains wrappers around lower-level functionality.
22module Servant.QuickCheck.Internal.QuickCheck where
33
4+import qualified Data.ByteString.Lazy as LBS
45import Data.Proxy (Proxy)
5−import Network.HTTP.Client (Manager, defaultManagerSettings,
6− newManager, httpLbs, checkStatus, Request)
6+import Data.Text (Text)
7+import Network.HTTP.Client (Manager, Request, checkStatus,
8+ defaultManagerSettings, httpLbs,
9+ newManager)
710import Network.Wai.Handler.Warp (withApplication)
811import Servant (HasServer, Server, serve)
9−import Servant.Client (BaseUrl (..), Scheme (..) )
12+import Servant.Client (BaseUrl (..), Scheme (..))
13+import System.IO.Unsafe (unsafePerformIO)
1014import Test.Hspec (Expectation, expectationFailure)
1115import Test.QuickCheck (Args (..), Result (..),
1216 quickCheckWithResult)
13−import System.IO.Unsafe (unsafePerformIO)
14−import Test.QuickCheck.Monadic
15−import qualified Data.ByteString.Lazy as LBS
16−import Data.Text (Text)
17+import Test.QuickCheck.Monadic
1718
1819import Servant.QuickCheck.Internal.HasGenRequest
1920import Servant.QuickCheck.Internal.Predicates
@@ -54,13 +55,29 @@ serversEqual api burl1 burl2 args req = do
5455 NoExpectedFailure {} -> expectationFailure $ "No expected failure"
5556 InsufficientCoverage {} -> expectationFailure $ "Insufficient coverage"
5657
58+-- | Check that a server satisfies the set of properties specified.
59+--
60+-- Note that, rather than having separate tests for each property you'd like to
61+-- test, you should generally prefer to combine all properties into a single
62+-- test. This enables a more parsimonious generation of requests and responses
63+-- with the same testing depth.
64+--
65+-- Example usage:
66+--
67+-- > goodAPISpec = describe "my server" $ do
68+-- >
69+-- > it "follows best practices" $ do
70+-- > withServantServer api server $ \burl ->
71+-- > serverSatisfies api burl stdArgs (not500
72+-- > <%> onlyJsonObjects
73+-- > <%> notAllowedContainsAllowHeader
74+-- > <%> mempty)
5775serverSatisfies :: (HasGenRequest a) =>
5876 Proxy a -> BaseUrl -> Args -> Predicates [Text] [Text] -> Expectation
5977serverSatisfies api burl args preds = do
6078 let reqs = ($ burl) <$> genRequest api
6179 r <- quickCheckWithResult args $ monadicIO $ forAllM reqs $ \req -> do
6280 v <- run $ finishPredicates preds (noCheckStatus req) defManager
63− {-run $ print v-}
6481 assert $ null v
6582 case r of
6683 Success {} -> return ()