mirror of
https://github.com/ilyakooo0/servant-quickcheck.git
synced 2024-08-17 06:10:27 +03:00
Add notLongerThan predicate.
This commit is contained in:
parent
b4876468e6
commit
feff40b2e4
@ -36,6 +36,7 @@ library
|
||||
, aeson > 0.8 && < 2
|
||||
, bytestring == 0.10.*
|
||||
, case-insensitive == 1.2.*
|
||||
, clock >= 0.7 && < 0.8
|
||||
, data-default-class >= 0.0 && < 0.2
|
||||
, hspec == 2.2.*
|
||||
, http-client >= 0.4.30 && < 0.6
|
||||
|
@ -27,6 +27,7 @@ module Servant.QuickCheck
|
||||
-- in RFCs. The __Best Practices__ includes, in addition to RFC
|
||||
-- recommendations, recommendations found elsewhere or generally accepted.
|
||||
, not500
|
||||
, notLongerThan
|
||||
, onlyJsonObjects
|
||||
, notAllowedContainsAllowHeader
|
||||
, unauthorizedContainsWWWAuthenticate
|
||||
|
@ -5,7 +5,6 @@ module Servant.QuickCheck.Internal.HasGenRequest where
|
||||
import Data.Monoid ((<>))
|
||||
import Data.String (fromString)
|
||||
import Data.String.Conversions (cs)
|
||||
import qualified Data.ByteString as BS
|
||||
import GHC.TypeLits (KnownSymbol, Nat, symbolVal)
|
||||
import Network.HTTP.Client (Request, RequestBody (..), host, method, path,
|
||||
port, queryString, requestBody, requestHeaders,
|
||||
@ -16,6 +15,9 @@ import Servant
|
||||
import Servant.API.ContentTypes (AllMimeRender (..))
|
||||
import Servant.Client (BaseUrl (..), Scheme (..))
|
||||
import Test.QuickCheck (Arbitrary (..), Gen, elements, oneof)
|
||||
#if MIN_VERSION_servant(0,8,0)
|
||||
import qualified Data.ByteString as BS
|
||||
#endif
|
||||
|
||||
|
||||
class HasGenRequest a where
|
||||
|
@ -22,6 +22,7 @@ import Network.HTTP.Types (methodGet, methodHead, parseMethod,
|
||||
renderStdMethod, status100, status200,
|
||||
status201, status300, status401,
|
||||
status405, status500)
|
||||
import System.Clock (toNanoSecs, Clock(Monotonic), getTime, diffTimeSpec)
|
||||
import Prelude.Compat
|
||||
|
||||
import Servant.QuickCheck.Internal.ErrorTypes
|
||||
@ -40,6 +41,22 @@ not500 :: ResponsePredicate
|
||||
not500 = ResponsePredicate $ \resp ->
|
||||
when (responseStatus resp == status500) $ fail "not500"
|
||||
|
||||
-- | [__Optional__]
|
||||
--
|
||||
-- This function checks that the response from the server does not take longer
|
||||
-- than the specified number of nanoseconds.
|
||||
--
|
||||
-- #SINCE#
|
||||
notLongerThan :: Integer -> RequestPredicate
|
||||
notLongerThan maxAllowed
|
||||
= RequestPredicate $ \req mgr -> do
|
||||
start <- getTime Monotonic
|
||||
resp <- httpLbs req mgr
|
||||
end <- getTime Monotonic
|
||||
when (toNanoSecs (end `diffTimeSpec` start) > maxAllowed) $
|
||||
throw $ PredicateFailure "notLongerThan" (Just req) resp
|
||||
return []
|
||||
|
||||
-- | [__Best Practice__]
|
||||
--
|
||||
-- Returning anything other than an object when returning JSON is considered
|
||||
@ -126,7 +143,7 @@ createContainsValidLocation
|
||||
-- * If-Unmodified-Since header: <https://tools.ietf.org/html/rfc7232#section-3.4 RFC 7232 Section 3.4>
|
||||
-- * Date format: <https://tools.ietf.org/html/rfc2616#section-3.3 RFC 2616 Section 3.3>
|
||||
--
|
||||
-- #SINCECURRENT#
|
||||
-- #SINCE#
|
||||
getsHaveLastModifiedHeader :: RequestPredicate
|
||||
getsHaveLastModifiedHeader
|
||||
= RequestPredicate $ \req mgr ->
|
||||
|
@ -25,6 +25,7 @@ spec = do
|
||||
serverSatisfiesSpec
|
||||
isComprehensiveSpec
|
||||
onlyJsonObjectSpec
|
||||
notLongerThanSpec
|
||||
|
||||
serversEqualSpec :: Spec
|
||||
serversEqualSpec = describe "serversEqual" $ do
|
||||
@ -80,6 +81,18 @@ onlyJsonObjectSpec = describe "onlyJsonObjects" $ do
|
||||
(onlyJsonObjects <%> mempty)
|
||||
err `shouldContain` "onlyJsonObjects"
|
||||
|
||||
notLongerThanSpec :: Spec
|
||||
notLongerThanSpec = describe "notLongerThan" $ do
|
||||
|
||||
it "fails correctly" $ do
|
||||
Fail _ err <- withServantServerAndContext api ctx server $ \burl -> do
|
||||
evalExample $ serverSatisfies (Proxy :: Proxy (Get '[JSON] Int)) burl args
|
||||
(notLongerThan 1 <%> mempty)
|
||||
err `shouldContain` "notLongerThan"
|
||||
|
||||
it "succeeds correctly" $ do
|
||||
withServantServerAndContext api ctx server $ \burl ->
|
||||
serverSatisfies api burl args (notLongerThan 1000000000000 <%> mempty)
|
||||
|
||||
isComprehensiveSpec :: Spec
|
||||
isComprehensiveSpec = describe "HasGenRequest" $ do
|
||||
|
Loading…
Reference in New Issue
Block a user