mirror of
https://github.com/ilyakooo0/servant-quickcheck.git
synced 2024-09-11 18:37:09 +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"
|
||||
|
@ -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__
|
||||
--
|
||||
|
@ -3,18 +3,20 @@ module Servant.QuickCheck.InternalSpec (spec) where
|
||||
|
||||
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