mirror of
https://github.com/ilyakooo0/servant-quickcheck.git
synced 2024-09-11 18:37:09 +03:00
Fix a bug in onlyJsonObjects that made it fail if there was no
content-type.
This commit is contained in:
parent
e3bf044741
commit
9743ac5ec4
@ -84,15 +84,13 @@ notLongerThan maxAllowed
|
||||
-- /Since 0.0.0.0/
|
||||
onlyJsonObjects :: ResponsePredicate
|
||||
onlyJsonObjects
|
||||
= ResponsePredicate (\resp -> case go resp of
|
||||
Nothing -> throw $ PredicateFailure "onlyJsonObjects" Nothing resp
|
||||
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 ()
|
||||
= ResponsePredicate (\resp -> do
|
||||
case lookup "content-type" (first foldedCase <$> responseHeaders resp) of
|
||||
Nothing -> return ()
|
||||
Just ctype -> when ("application/json" `SBS.isPrefixOf` ctype) $ do
|
||||
case (decode (responseBody resp) :: Maybe Object) of
|
||||
Nothing -> throw $ PredicateFailure "onlyJsonObjects" Nothing resp
|
||||
Just _ -> return ())
|
||||
|
||||
-- | __Optional__
|
||||
--
|
||||
|
Loading…
Reference in New Issue
Block a user