servant-quickcheck 0.0.4.1 → 0.0.5.0

raw patch · 4 files changed

+26/−39 lines, 4 files

Files

• CHANGELOG.yaml +9/−8
• servant-quickcheck.cabal +1/−1
• src/Servant/QuickCheck.hs +2/−0
• src/Servant/QuickCheck/Internal/QuickCheck.hs +14/−30

@@ -1,13 +1,16 @@ upcoming:  releases:-  - version: "0.0.4.1"++  - version: "0.0.5.0"     changes:-      - description: Backport "should not happen" error fixes and configurable manager-        issue: 47, 48-        authors: parsonsmatt-        date: 2018-05-10 +      - description: Export forgotten predicates+        issue: none+        pr: 40+        authors: Phenitei+        date: 2017-12-14+   - version: "0.0.4"     changes: @@ -16,14 +19,12 @@         authors: phadej         date: 2017-11-07 -  - version: "0.0.3.1"-    changes:-       - description: Support for Servant 0.11         issue: none         pr: 32         authors: adinapoli-iohk         date: 2017-10-18+        notes: Includes 0-weighted instance for EmptyAPI    - version: "0.0.3.0"     changes:

@@ -1,5 +1,5 @@ name:                servant-quickcheck-version:             0.0.4.1+version:             0.0.5.0 synopsis:            QuickCheck entire APIs description:  This packages provides QuickCheck properties that are tested across an entire

@@ -29,8 +29,10 @@   , not500   , notLongerThan   , onlyJsonObjects+  , honoursAcceptHeader   , notAllowedContainsAllowHeader   , unauthorizedContainsWWWAuthenticate+  , getsHaveLastModifiedHeader   , getsHaveCacheControlHeader   , headsHaveCacheControlHeader   , createContainsValidLocation

@@ -2,10 +2,9 @@ {-# LANGUAGE CPP #-} module Servant.QuickCheck.Internal.QuickCheck where -import           Control.Concurrent       (tryReadMVar, newEmptyMVar, tryPutMVar)+import           Control.Concurrent       (modifyMVar_, newMVar, readMVar) import           Control.Monad            (unless) import qualified Data.ByteString.Lazy     as LBS-import           Data.Monoid              ((<>)) import           Data.Proxy               (Proxy) import qualified Network.HTTP.Client      as C import           Network.Wai.Handler.Warp (withApplication)@@ -74,23 +73,18 @@   let reqs = (\f -> (f burl1, f burl2)) <$> runGenRequest api   -- This MVar stuff is clunky! But there doesn't seem to be an easy way to   -- return results when a test fails, since an exception is throw.-  deetsMVar <- newEmptyMVar+  deetsMVar <- newMVar $ error "should not be called"   r <- quickCheckWithResult args { chatty = False } $ monadicIO $ forAllM reqs $ \(req1, req2) -> do     resp1 <- run $ C.httpLbs (noCheckStatus req1) defManager     resp2 <- run $ C.httpLbs (noCheckStatus req2) defManager     unless (getResponseEquality req resp1 resp2) $ do       monitor (counterexample "hi" )-      _ <- run $ tryPutMVar deetsMVar $ ServerEqualityFailure req1 resp1 resp2+      run $ modifyMVar_ deetsMVar $ const $ return $+        ServerEqualityFailure req1 resp1 resp2       assert False   case r of     Success {} -> return ()-    Failure{..} -> do-      mx <- tryReadMVar deetsMVar-      case mx of-        Just x ->-          expectationFailure $ "Failed:\n" ++ show x-        Nothing ->-          expectationFailure $ "We failed to record a reason for failure: " <> show r+    Failure{..} -> readMVar deetsMVar >>= \x -> expectationFailure $ "Failed:\n" ++ show x     GaveUp { numTests = n } -> expectationFailure $ "Gave up after " ++ show n ++ " tests"     NoExpectedFailure {} -> expectationFailure "No expected failure"     InsufficientCoverage {} -> expectationFailure "Insufficient coverage"@@ -116,40 +110,30 @@ -- /Since 0.0.0.0/ serverSatisfies :: (HasGenRequest a) =>   Proxy a -> BaseUrl -> Args -> Predicates -> Expectation-serverSatisfies api =  serverSatisfiesMgr api defManager--serverSatisfiesMgr :: (HasGenRequest a) =>-  Proxy a -> C.Manager -> BaseUrl -> Args -> Predicates -> Expectation-serverSatisfiesMgr api manager burl args preds = do+serverSatisfies api burl args preds = do   let reqs = ($ burl) <$> runGenRequest api-  deetsMVar <- newEmptyMVar+  deetsMVar <- newMVar $ error "should not be called"   r <- quickCheckWithResult args { chatty = False } $ monadicIO $ forAllM reqs $ \req -> do-     v <- run $ finishPredicates preds (noCheckStatus req) manager-     _ <- run $ tryPutMVar deetsMVar v+     v <- run $ finishPredicates preds (noCheckStatus req) defManager+     run $ modifyMVar_ deetsMVar $ const $ return v      case v of        Just _ -> assert False        _ -> return ()   case r of     Success {} -> return ()-    Failure {..} -> do-      mx <- tryReadMVar deetsMVar-      case mx of-        Just x -> expectationFailure $ "Failed:\n" ++ show x-        Nothing -> expectationFailure $ "Failed to retrieve error. QC Failure: " <> show r+    Failure{..} -> readMVar deetsMVar >>= \x -> expectationFailure $+      "Failed:\n" ++ show x     GaveUp { numTests = n } -> expectationFailure $ "Gave up after " ++ show n ++ " tests"     NoExpectedFailure {} -> expectationFailure $ "No expected failure"     InsufficientCoverage {} -> expectationFailure $ "Insufficient coverage" + serverDoesntSatisfy :: (HasGenRequest a) =>   Proxy a -> BaseUrl -> Args -> Predicates -> Expectation-serverDoesntSatisfy api = serverDoesntSatisfyMgr api defManager--serverDoesntSatisfyMgr :: (HasGenRequest a) =>-  Proxy a -> C.Manager -> BaseUrl -> Args -> Predicates -> Expectation-serverDoesntSatisfyMgr api manager burl args preds = do+serverDoesntSatisfy api burl args preds = do   let reqs = ($ burl) <$> runGenRequest api   r <- quickCheckWithResult args $ monadicIO $ forAllM reqs $ \req -> do-     v <- run $ finishPredicates preds (noCheckStatus req) manager+     v <- run $ finishPredicates preds (noCheckStatus req) defManager      assert $ not $ null v   case r of     Success {} -> return ()