mirror of
https://github.com/ilyakooo0/servant-quickcheck.git
synced 2024-08-17 06:10:27 +03:00
Make onlyJsonObjects succeed in non-JSON endpoints.
This commit is contained in:
parent
4f5e6ba25a
commit
b1227d3864
@ -1,5 +1,10 @@
|
||||
upcoming:
|
||||
|
||||
- description: Make onlyJsonObjects succeed in non-JSON endpoints
|
||||
issue: 20
|
||||
authors: jkarni
|
||||
date: 2016-10-18
|
||||
|
||||
releases:
|
||||
|
||||
- version: "0.0.2.1"
|
||||
@ -15,9 +20,9 @@ releases:
|
||||
authors: jkarni
|
||||
date: 2016-10-03
|
||||
|
||||
- description: Raise upper bounds
|
||||
- description: Raise upper bounds
|
||||
notes: >
|
||||
For Quickcheck, aeson, http-client, servant, servant-client and
|
||||
For Quickcheck, aeson, http-client, servant, servant-client and
|
||||
servant-server.
|
||||
pr: none
|
||||
authors: jkarni
|
||||
|
@ -85,6 +85,7 @@ test-suite spec
|
||||
build-depends: base == 4.*
|
||||
, base-compat
|
||||
, servant-quickcheck
|
||||
, bytestring
|
||||
, hspec
|
||||
, hspec-core
|
||||
, http-client
|
||||
|
@ -1,29 +1,32 @@
|
||||
module Servant.QuickCheck.Internal.Predicates where
|
||||
|
||||
import Control.Exception (catch, throw)
|
||||
import Control.Monad (when, unless, liftM2)
|
||||
import Control.Monad (liftM2, unless, when)
|
||||
import Data.Aeson (Object, decode)
|
||||
import Data.Bifunctor (first)
|
||||
import qualified Data.ByteString as SBS
|
||||
import qualified Data.ByteString.Char8 as SBSC
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import Data.CaseInsensitive (mk)
|
||||
import Data.CaseInsensitive (mk, foldedCase)
|
||||
import Data.Either (isRight)
|
||||
import Data.List.Split (wordsBy)
|
||||
import Data.Maybe (fromMaybe, isJust)
|
||||
import Data.Monoid ((<>))
|
||||
import Data.Time (parseTimeM, defaultTimeLocale,
|
||||
rfc822DateFormat, UTCTime)
|
||||
import Data.Time (UTCTime, defaultTimeLocale, parseTimeM,
|
||||
rfc822DateFormat)
|
||||
import GHC.Generics (Generic)
|
||||
import Network.HTTP.Client (Manager, Request, Response, httpLbs,
|
||||
method, requestHeaders, responseBody,
|
||||
responseHeaders, parseRequest, responseStatus)
|
||||
method, parseRequest, requestHeaders,
|
||||
responseBody, responseHeaders,
|
||||
responseStatus)
|
||||
import Network.HTTP.Media (matchAccept)
|
||||
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 System.Clock (Clock (Monotonic), diffTimeSpec,
|
||||
getTime, toNanoSecs)
|
||||
|
||||
import Servant.QuickCheck.Internal.ErrorTypes
|
||||
|
||||
@ -80,9 +83,15 @@ notLongerThan maxAllowed
|
||||
-- /Since 0.0.0.0/
|
||||
onlyJsonObjects :: ResponsePredicate
|
||||
onlyJsonObjects
|
||||
= ResponsePredicate (\resp -> case decode (responseBody resp) of
|
||||
= ResponsePredicate (\resp -> case go resp of
|
||||
Nothing -> throw $ PredicateFailure "onlyJsonObjects" Nothing resp
|
||||
Just (_ :: Object) -> return ())
|
||||
Just () -> return ())
|
||||
where
|
||||
go r = do
|
||||
ctyp <- lookup "content-type" (first foldedCase <$> responseHeaders r)
|
||||
when ("application/json" `SBS.isPrefixOf` ctyp) $ do
|
||||
(_ :: Object) <- decode (responseBody r)
|
||||
return ()
|
||||
|
||||
-- | __Optional__
|
||||
--
|
||||
@ -353,7 +362,7 @@ instance Monoid ResponsePredicate where
|
||||
--
|
||||
-- /Since 0.0.0.0/
|
||||
newtype RequestPredicate = RequestPredicate
|
||||
{ getRequestPredicate :: Request -> Manager -> IO [Response LBS.ByteString]
|
||||
{ getRequestPredicate :: Request -> Manager -> IO [Response LBS.ByteString]
|
||||
} deriving (Generic)
|
||||
|
||||
-- TODO: This isn't actually a monoid
|
||||
@ -364,7 +373,7 @@ instance Monoid RequestPredicate where
|
||||
|
||||
-- | A set of predicates. Construct one with 'mempty' and '<%>'.
|
||||
data Predicates = Predicates
|
||||
{ requestPredicates :: RequestPredicate
|
||||
{ requestPredicates :: RequestPredicate
|
||||
, responsePredicates :: ResponsePredicate
|
||||
} deriving (Generic)
|
||||
|
||||
|
@ -1,20 +1,22 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
module Servant.QuickCheck.InternalSpec (spec) where
|
||||
|
||||
import Control.Concurrent.MVar (newMVar, readMVar, swapMVar)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Prelude.Compat
|
||||
import Servant
|
||||
import Control.Concurrent.MVar (newMVar, readMVar, swapMVar)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import qualified Data.ByteString as BS
|
||||
import Prelude.Compat
|
||||
import Servant
|
||||
import Test.Hspec (Spec, context, describe, it, shouldBe,
|
||||
shouldContain)
|
||||
import Test.Hspec.Core.Spec (Arg, Example, Result (..),
|
||||
defaultParams, evaluateExample)
|
||||
|
||||
#if MIN_VERSION_servant(0,8,0)
|
||||
import Servant.API.Internal.Test.ComprehensiveAPI (comprehensiveAPIWithoutRaw)
|
||||
#else
|
||||
import Servant.API.Internal.Test.ComprehensiveAPI (comprehensiveAPI, ComprehensiveAPI)
|
||||
import Servant.API.Internal.Test.ComprehensiveAPI (ComprehensiveAPI,
|
||||
comprehensiveAPI)
|
||||
#endif
|
||||
import Test.Hspec (Spec, context, describe, it,
|
||||
shouldBe, shouldContain)
|
||||
import Test.Hspec.Core.Spec (Arg, Example, Result (..),
|
||||
defaultParams,
|
||||
evaluateExample)
|
||||
|
||||
import Servant.QuickCheck
|
||||
import Servant.QuickCheck.Internal (genRequest, serverDoesntSatisfy)
|
||||
@ -81,6 +83,10 @@ onlyJsonObjectSpec = describe "onlyJsonObjects" $ do
|
||||
(onlyJsonObjects <%> mempty)
|
||||
err `shouldContain` "onlyJsonObjects"
|
||||
|
||||
it "accepts non-JSON endpoints" $ do
|
||||
withServantServerAndContext octetAPI ctx serverOctetAPI $ \burl ->
|
||||
serverSatisfies octetAPI burl args (onlyJsonObjects <%> mempty)
|
||||
|
||||
notLongerThanSpec :: Spec
|
||||
notLongerThanSpec = describe "notLongerThan" $ do
|
||||
|
||||
@ -132,6 +138,14 @@ server2 = return $ return 1
|
||||
server3 :: IO (Server API2)
|
||||
server3 = return $ return 2
|
||||
|
||||
type OctetAPI = Get '[OctetStream] BS.ByteString
|
||||
|
||||
octetAPI :: Proxy OctetAPI
|
||||
octetAPI = Proxy
|
||||
|
||||
serverOctetAPI :: IO (Server OctetAPI)
|
||||
serverOctetAPI = return $ return "blah"
|
||||
|
||||
ctx :: Context '[BasicAuthCheck ()]
|
||||
ctx = BasicAuthCheck (const . return $ NoSuchUser) :. EmptyContext
|
||||
------------------------------------------------------------------------------
|
||||
|
Loading…
Reference in New Issue
Block a user