diff --git a/src/Servant/QuickCheck.hs b/src/Servant/QuickCheck.hs index e6f1440..0b154df 100644 --- a/src/Servant/QuickCheck.hs +++ b/src/Servant/QuickCheck.hs @@ -59,9 +59,12 @@ module Servant.QuickCheck , defaultArgs -- ** Re-exports + -- | Types and constructors from other packages that are generally needed for + -- using @servant-quickcheck@. , BaseUrl(..) , Scheme(..) , Args(..) + , Proxy(..) ) where @@ -69,6 +72,10 @@ module Servant.QuickCheck import Servant.QuickCheck.Internal import Servant.Client (BaseUrl(..), Scheme(..)) import Test.QuickCheck (Args(..), stdArgs) +import Data.Proxy (Proxy(..)) +-- | QuickCheck @Args@ with 1000 rather than 100 test cases. +-- +-- /Since 0.0.0.0/ defaultArgs :: Args defaultArgs = stdArgs { maxSuccess = 1000 } diff --git a/src/Servant/QuickCheck/Internal/Equality.hs b/src/Servant/QuickCheck/Internal/Equality.hs index 1195dae..4bfb83d 100644 --- a/src/Servant/QuickCheck/Internal/Equality.hs +++ b/src/Servant/QuickCheck/Internal/Equality.hs @@ -14,12 +14,12 @@ instance Monoid (ResponseEquality b) where -- | Use `Eq` instance for `Response` -- --- #SINCE# +-- /Since 0.0.0.0/ allEquality :: Eq b => ResponseEquality b allEquality = ResponseEquality (==) -- | ByteString `Eq` instance over the response body. -- --- #SINCE# +-- /Since 0.0.0.0/ bodyEquality :: Eq b => ResponseEquality b bodyEquality = ResponseEquality ((==) `on` responseBody) diff --git a/src/Servant/QuickCheck/Internal/Predicates.hs b/src/Servant/QuickCheck/Internal/Predicates.hs index e213e81..7716637 100644 --- a/src/Servant/QuickCheck/Internal/Predicates.hs +++ b/src/Servant/QuickCheck/Internal/Predicates.hs @@ -31,6 +31,8 @@ import Network.HTTP.Types (methodGet, methodHead, parseMethod, -- indication of how to proceed or what went wrong. -- -- This function checks that the response code is not 500. +-- +-- /Since 0.0.0.0/ not500 :: ResponsePredicate Text Bool not500 = ResponsePredicate "not500" (\resp -> not $ responseStatus resp == status500) @@ -53,6 +55,8 @@ not500 = ResponsePredicate "not500" (\resp -> not $ responseStatus resp == statu -- -- * JSON Grammar: -- * JSON Grammar: +-- +-- /Since 0.0.0.0/ onlyJsonObjects :: ResponsePredicate Text Bool onlyJsonObjects = ResponsePredicate "onlyJsonObjects" (\resp -> case decode (responseBody resp) of @@ -76,6 +80,8 @@ onlyJsonObjects -- -- * 201 Created: -- * Location header: +-- +-- /Since 0.0.0.0/ createContainsValidLocation :: RequestPredicate Text Bool createContainsValidLocation = RequestPredicate @@ -114,6 +120,8 @@ getsHaveLastModifiedHeader -- -- * @Allow@ header: -- * Status 405: +-- +-- /Since 0.0.0.0/ notAllowedContainsAllowHeader :: RequestPredicate Text Bool notAllowedContainsAllowHeader = RequestPredicate @@ -144,6 +152,8 @@ notAllowedContainsAllowHeader -- __References__: -- -- * @Accept@ header: +-- +-- /Since 0.0.0.0/ honoursAcceptHeader :: RequestPredicate Text Bool honoursAcceptHeader = RequestPredicate @@ -171,7 +181,7 @@ honoursAcceptHeader -- -- * @Cache-Control@ header: -- --- #SINCE# +-- /Since 0.0.0.0/ getsHaveCacheControlHeader :: RequestPredicate Text Bool getsHaveCacheControlHeader = RequestPredicate @@ -188,7 +198,7 @@ getsHaveCacheControlHeader -- -- Like 'getsHaveCacheControlHeader', but for @HEAD@ requests. -- --- #SINCE# +-- /Since 0.0.0.0/ headsHaveCacheControlHeader :: RequestPredicate Text Bool headsHaveCacheControlHeader = RequestPredicate @@ -260,7 +270,7 @@ linkHeadersAreValid -- -- * @WWW-Authenticate@ header: -- --- #SINCE# +-- /Since 0.0.0.0/ unauthorizedContainsWWWAuthenticate :: ResponsePredicate Text Bool unauthorizedContainsWWWAuthenticate = ResponsePredicate "unauthorizedContainsWWWAuthenticate" (\resp -> @@ -276,6 +286,9 @@ unauthorizedContainsWWWAuthenticate -- -- Still, this is all kind of ugly. +-- | A predicate that depends only on the response. +-- +-- /Since 0.0.0.0/ data ResponsePredicate n r = ResponsePredicate { respPredName :: n , respPred :: Response LBS.ByteString -> r @@ -292,6 +305,9 @@ instance (Monoid n, Monoid r) => Monoid (ResponsePredicate n r) where , respPred = respPred a <> respPred b } +-- | A predicate that depends on both the request and the response. +-- +-- /Since 0.0.0.0/ data RequestPredicate n r = RequestPredicate { reqPredName :: n , reqResps :: Request -> Manager -> IO (r, [Response LBS.ByteString]) @@ -309,6 +325,7 @@ instance (Monoid n, Monoid r) => Monoid (RequestPredicate n r) where , reqResps = \x m -> liftM2 (<>) (reqResps a x m) (reqResps b x m) } +-- | A set of predicates. Construct one with 'mempty' and '<%>'. data Predicates n r = Predicates { reqPreds :: RequestPredicate n r , respPreds :: ResponsePredicate n r @@ -339,7 +356,7 @@ instance JoinPreds (ResponsePredicate Text Bool) where -- -- > not500 <%> onlyJsonObjects <%> empty -- --- #SINCE# +-- /Since 0.0.0.0/ (<%>) :: JoinPreds a => a -> Predicates [Text] [Text] -> Predicates [Text] [Text] (<%>) = joinPreds infixr 6 <%> diff --git a/src/Servant/QuickCheck/Internal/QuickCheck.hs b/src/Servant/QuickCheck/Internal/QuickCheck.hs index e47f4cf..95081d4 100644 --- a/src/Servant/QuickCheck/Internal/QuickCheck.hs +++ b/src/Servant/QuickCheck/Internal/QuickCheck.hs @@ -25,7 +25,7 @@ import Servant.QuickCheck.Internal.Equality -- | Start a servant application on an open port, run the provided function, -- then stop the application. -- --- #SINCE# +-- /Since 0.0.0.0/ withServantServer :: HasServer a '[] => Proxy a -> IO (Server a) -> (BaseUrl -> IO r) -> IO r withServantServer api = withServantServerAndContext api EmptyContext @@ -33,7 +33,7 @@ withServantServer api = withServantServerAndContext api EmptyContext -- | Like 'withServantServer', but allows passing in a 'Context' to the -- application. -- --- #SINCE# +-- /Since 0.0.0.0/ withServantServerAndContext :: HasServer a ctx => Proxy a -> Context ctx -> IO (Server a) -> (BaseUrl -> IO r) -> IO r withServantServerAndContext api ctx server t @@ -52,7 +52,7 @@ withServantServerAndContext api ctx server t -- Evidently, if the behaviour of the server is expected to be -- non-deterministic, this function may produce spurious failures -- --- #SINCE# +-- /Since 0.0.0.0/ serversEqual :: HasGenRequest a => Proxy a -> BaseUrl -> BaseUrl -> Args -> ResponseEquality LBS.ByteString -> Expectation serversEqual api burl1 burl2 args req = do @@ -86,7 +86,7 @@ serversEqual api burl1 burl2 args req = do -- > <%> notAllowedContainsAllowHeader -- > <%> mempty) -- --- #SINCE# +-- /Since 0.0.0.0/ serverSatisfies :: (HasGenRequest a) => Proxy a -> BaseUrl -> Args -> Predicates [Text] [Text] -> Expectation serverSatisfies api burl args preds = do