76e3b8e · servant-quickcheck

git.iko.soy/servant-quickcheck

on master help sign in

Documentation improvements

76e3b8eJulian K. Arni11 years ago

src/Servant/QuickCheck.hs+20−17

compare with master

unifiedsplit

@@ -6,16 +6,6 @@

6-- tested itself need not be implemented with @servant-server@ (or indeed,

7-- written in Haskell).

8--

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

19module Servant.QuickCheck

9module Servant.QuickCheck

20 (

10 (

@@ -24,19 +14,32 @@ module Servant.QuickCheck

24 -- | Helpers to setup and teardown @servant@ servers during tests.

14 -- | Helpers to setup and teardown @servant@ servers during tests.

25 withServantServer

15 withServantServer

27− , serversEqual

28− , serverSatisfies

18+ -- * Equality testing

19+ , serversEqual

30− -- * Response equality

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

31 , bodyEquality

26 , bodyEquality

32 , allEquality

27 , allEquality

28+ -- ** Response equality type

33− , ResponseEquality(getResponseEquality)

29+ , ResponseEquality(..)

35− -- * Predicates

31+ -- * Property testing

36− , (<%>)

32+ , serverSatisfies

37− , Predicates

33+ -- ** Predicates

34+ -- *** Useful predicates

38 , not500

35 , not500

39 , onlyJsonObjects

36 , onlyJsonObjects

37+ , notAllowedContainsAllowHeader

38+ -- *** Predicate utilities and types

39+ , (<%>)

40+ , Predicates

41+ , ResponsePredicate(..)

42+ , RequestPredicate(..)

41 -- ** Re-exports

44 -- ** Re-exports

42 , BaseUrl(..)

45 , BaseUrl(..)

src/Servant/QuickCheck/Internal/Equality.hs+2−4

@@ -3,10 +3,6 @@ module Servant.QuickCheck.Internal.Equality where

3import Network.HTTP.Client

4import Data.Function (on)

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

10newtype ResponseEquality b

6newtype ResponseEquality b

11 = ResponseEquality { getResponseEquality :: Response b -> Response b -> Bool }

7 = ResponseEquality { getResponseEquality :: Response b -> Response b -> Bool }

@@ -15,8 +11,10 @@ instance Monoid (ResponseEquality b) where

15 ResponseEquality a `mappend` ResponseEquality b = ResponseEquality $ \x y ->

11 ResponseEquality a `mappend` ResponseEquality b = ResponseEquality $ \x y ->

16 a x y && b x y

12 a x y && b x y

14+-- | Use `Eq` instance for `Response`

18allEquality :: Eq b => ResponseEquality b

15allEquality :: Eq b => ResponseEquality b

19allEquality = ResponseEquality (==)

16allEquality = ResponseEquality (==)

18+-- | ByteString `Eq` instance over the response body.

21bodyEquality :: Eq b => ResponseEquality b

19bodyEquality :: Eq b => ResponseEquality b

22bodyEquality = ResponseEquality ((==) `on` responseBody)

20bodyEquality = ResponseEquality ((==) `on` responseBody)

src/Servant/QuickCheck/Internal/Predicates.hs+6−1

@@ -229,9 +229,14 @@ instance JoinPreds (ResponsePredicate Text Bool) where

229 where go = let p' = first return p

230 in fmap (\z -> if z then [] else respPredName p') p'

231

232−infixr 6 <%>

232+

233+-- | Adds a new predicate (either `ResponsePredicate` or `RequestPredicate`) to

234+-- the existing predicates.

235+--

236+-- > not500 <%> onlyJsonObjects <%> empty

233(<%>) :: JoinPreds a => a -> Predicates [Text] [Text] -> Predicates [Text] [Text]

237(<%>) :: JoinPreds a => a -> Predicates [Text] [Text] -> Predicates [Text] [Text]

234(<%>) = joinPreds

238(<%>) = joinPreds

239+infixr 6 <%>

235

240

236finishPredicates :: Predicates [Text] [Text] -> Request -> Manager -> IO [Text]

241finishPredicates :: Predicates [Text] [Text] -> Request -> Manager -> IO [Text]

237finishPredicates p req mgr = do

242finishPredicates p req mgr = do

src/Servant/QuickCheck/Internal/QuickCheck.hs+25−8

@@ -1,19 +1,20 @@

1-- | This module contains wrappers around lower-level functionality.

2module Servant.QuickCheck.Internal.QuickCheck where

4+import qualified Data.ByteString.Lazy as LBS

4import Data.Proxy (Proxy)

5import Data.Proxy (Proxy)

6+import Data.Text (Text)

7+import Network.HTTP.Client (Manager, Request, checkStatus,

5−import Network.HTTP.Client (Manager, defaultManagerSettings,

8+ defaultManagerSettings, httpLbs,

6− newManager, httpLbs, checkStatus, Request)

9+ newManager)

7import Network.Wai.Handler.Warp (withApplication)

10import Network.Wai.Handler.Warp (withApplication)

8import Servant (HasServer, Server, serve)

11import Servant (HasServer, Server, serve)

9−import Servant.Client (BaseUrl (..), Scheme (..) )

12+import Servant.Client (BaseUrl (..), Scheme (..))

13+import System.IO.Unsafe (unsafePerformIO)

10import Test.Hspec (Expectation, expectationFailure)

14import Test.Hspec (Expectation, expectationFailure)

11import Test.QuickCheck (Args (..), Result (..),

15import Test.QuickCheck (Args (..), Result (..),

12 quickCheckWithResult)

16 quickCheckWithResult)

13−import System.IO.Unsafe (unsafePerformIO)

14−import Test.QuickCheck.Monadic

17+import Test.QuickCheck.Monadic

15−import qualified Data.ByteString.Lazy as LBS

16−import Data.Text (Text)

18import Servant.QuickCheck.Internal.HasGenRequest

19import Servant.QuickCheck.Internal.HasGenRequest

19import Servant.QuickCheck.Internal.Predicates

20import Servant.QuickCheck.Internal.Predicates

@@ -54,13 +55,29 @@ serversEqual api burl1 burl2 args req = do

54 NoExpectedFailure {} -> expectationFailure $ "No expected failure"

55 NoExpectedFailure {} -> expectationFailure $ "No expected failure"

55 InsufficientCoverage {} -> expectationFailure $ "Insufficient coverage"

56 InsufficientCoverage {} -> expectationFailure $ "Insufficient coverage"

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)

57serverSatisfies :: (HasGenRequest a) =>

75serverSatisfies :: (HasGenRequest a) =>

58 Proxy a -> BaseUrl -> Args -> Predicates [Text] [Text] -> Expectation

76 Proxy a -> BaseUrl -> Args -> Predicates [Text] [Text] -> Expectation

59serverSatisfies api burl args preds = do

77serverSatisfies api burl args preds = do

60 let reqs = ($ burl) <$> genRequest api

78 let reqs = ($ burl) <$> genRequest api

61 r <- quickCheckWithResult args $ monadicIO $ forAllM reqs $ \req -> do

79 r <- quickCheckWithResult args $ monadicIO $ forAllM reqs $ \req -> do

62 v <- run $ finishPredicates preds (noCheckStatus req) defManager

80 v <- run $ finishPredicates preds (noCheckStatus req) defManager

63− {-run $ print v-}

64 assert $ null v

81 assert $ null v

65 case r of

82 case r of

66 Success {} -> return ()

83 Success {} -> return ()