This commit is contained in:
Julian K. Arni 2016-08-28 19:31:42 -03:00
parent ca0b7156d8
commit 86d99239bb
4 changed files with 14 additions and 20 deletions

View File

@ -36,11 +36,11 @@ library
, http-client == 0.4.*
, http-types == 0.9.*
, http-media == 0.6.*
, servant-client == 0.7.*
, servant-server == 0.7.*
, servant-client > 0.6 && < 0.9
, servant-server > 0.6 && < 0.9
, string-conversions == 0.4.*
, data-default-class == 0.0.*
, servant == 0.7.*
, servant > 0.6 && < 0.9
, warp >= 3.2.4 && < 3.3
, process == 1.2.*
, temporary == 1.2.*
@ -68,6 +68,7 @@ library
, OverloadedStrings
, FunctionalDependencies
, NoImplicitPrelude
, AutoDeriveTypeable
default-language: Haskell2010
test-suite spec

View File

@ -1,10 +1,8 @@
module Servant.QuickCheck.Internal.Predicates where
import Control.Exception (SomeException, catch, throw)
import Control.Monad (ap, guard, liftM2)
import Control.Exception (catch, throw)
import Control.Monad.Reader
import Data.Aeson (Object, decode)
import Data.Bifunctor (Bifunctor (..))
import qualified Data.ByteString as SBS
import qualified Data.ByteString.Char8 as SBSC
import qualified Data.ByteString.Lazy as LBS
@ -13,12 +11,10 @@ import Data.Either (isRight)
import Data.List.Split (wordsBy)
import Data.Maybe (fromMaybe, isJust)
import Data.Monoid ((<>))
import Data.Text (Text)
import GHC.Generics (Generic)
import Network.HTTP.Client (Manager, Request, Response, httpLbs,
method, parseUrl, requestHeaders,
responseBody, responseHeaders,
responseStatus)
method, requestHeaders, responseBody,
responseHeaders, parseUrl, responseStatus)
import Network.HTTP.Media (matchAccept)
import Network.HTTP.Types (methodGet, methodHead, parseMethod,
renderStdMethod, status100, status200,
@ -134,7 +130,7 @@ notAllowedContainsAllowHeader
| m <- [minBound .. maxBound ]
, renderStdMethod m /= method req ]
case filter pred' resp of
(x:xs) -> throw $ PredicateFailure "notAllowedContainsAllowHeader" (Just req) x
(x:_) -> throw $ PredicateFailure "notAllowedContainsAllowHeader" (Just req) x
[] -> return resp
where
pred' resp = responseStatus resp == status405 && not (hasValidHeader "Allow" go resp)

View File

@ -5,9 +5,6 @@ import Control.Concurrent (modifyMVar_, newMVar, readMVar)
import Control.Monad (unless)
import qualified Data.ByteString.Lazy as LBS
import Data.Proxy (Proxy)
import Data.String (IsString (..))
import Data.Text (Text)
import GHC.Generics (Generic)
import qualified Network.HTTP.Client as C
import Network.Wai.Handler.Warp (withApplication)
import Prelude.Compat
@ -87,7 +84,7 @@ serversEqual api burl1 burl2 args req = do
assert False
case r of
Success {} -> return ()
f@Failure{..} -> readMVar deetsMVar >>= \x -> expectationFailure $
Failure{..} -> readMVar deetsMVar >>= \x -> expectationFailure $
"Failed:\n" ++ show x
GaveUp { numTests = n } -> expectationFailure $ "Gave up after " ++ show n ++ " tests"
NoExpectedFailure {} -> expectationFailure $ "No expected failure"
@ -121,11 +118,11 @@ serverSatisfies api burl args preds = do
v <- run $ finishPredicates preds (noCheckStatus req) defManager
run $ modifyMVar_ deetsMVar $ const $ return v
case v of
Just x -> assert False
Just _ -> assert False
_ -> return ()
case r of
Success {} -> return ()
f@Failure{..} -> readMVar deetsMVar >>= \x -> expectationFailure $
Failure{..} -> readMVar deetsMVar >>= \x -> expectationFailure $
"Failed:\n" ++ show x
GaveUp { numTests = n } -> expectationFailure $ "Gave up after " ++ show n ++ " tests"
NoExpectedFailure {} -> expectationFailure $ "No expected failure"

View File

@ -7,9 +7,9 @@ packages:
# Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3)
extra-deps:
- servant-0.7
- servant-client-0.7
- servant-server-0.7
- servant-0.8
- servant-client-0.8
- servant-server-0.8
# Override default flag values for local packages and extra-deps
flags: {}