mirror of
https://github.com/ilyakooo0/servant-quickcheck.git
synced 2024-11-22 23:27:08 +03:00
Documentation improvements
This commit is contained in:
parent
c5172a1dc5
commit
26a6171265
@ -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 }
|
||||
|
@ -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)
|
||||
|
@ -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: <https://tools.ietf.org/html/rfc7159#section-2 RFC 7159 Section 2>
|
||||
-- * JSON Grammar: <https://tools.ietf.org/html/rfc4627#section-2 RFC 4627 Section 2>
|
||||
--
|
||||
-- /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: <https://tools.ietf.org/html/rfc7231#section-6.3.2 RFC 7231 Section 6.3.2>
|
||||
-- * Location header: <https://tools.ietf.org/html/rfc7231#section-7.1.2 RFC 7231 Section 7.1.2>
|
||||
--
|
||||
-- /Since 0.0.0.0/
|
||||
createContainsValidLocation :: RequestPredicate Text Bool
|
||||
createContainsValidLocation
|
||||
= RequestPredicate
|
||||
@ -114,6 +120,8 @@ getsHaveLastModifiedHeader
|
||||
--
|
||||
-- * @Allow@ header: <https://www.w3.org/Protocols/rfc2616/rfc2616-sec14.html RFC 2616 Section 14.7>
|
||||
-- * Status 405: <https://www.w3.org/Protocols/rfc2616/rfc2616-sec10.html RFC 2616 Section 10.4.6>
|
||||
--
|
||||
-- /Since 0.0.0.0/
|
||||
notAllowedContainsAllowHeader :: RequestPredicate Text Bool
|
||||
notAllowedContainsAllowHeader
|
||||
= RequestPredicate
|
||||
@ -144,6 +152,8 @@ notAllowedContainsAllowHeader
|
||||
-- __References__:
|
||||
--
|
||||
-- * @Accept@ header: <https://www.w3.org/Protocols/rfc2616/rfc2616-sec14.html RFC 2616 Section 14.1>
|
||||
--
|
||||
-- /Since 0.0.0.0/
|
||||
honoursAcceptHeader :: RequestPredicate Text Bool
|
||||
honoursAcceptHeader
|
||||
= RequestPredicate
|
||||
@ -171,7 +181,7 @@ honoursAcceptHeader
|
||||
--
|
||||
-- * @Cache-Control@ header: <https://tools.ietf.org/html/rfc7234#section-5.2 RFC 7234 Section 5.2>
|
||||
--
|
||||
-- #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: <https://tools.ietf.org/html/rfc7235#section-4.1 RFC 7235 Section 4.1>
|
||||
--
|
||||
-- #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 <%>
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user