Allow arbitrary JSON values (not only arrays and objects)

And added tests for QueryFlag.

servant.cabal

@@ -35,6 +35,7 @@ library
       base >=4.7 && <5
     , either
     , aeson
+    , attoparsec
     , bytestring
     , exceptions
     , string-conversions

src/Servant/Utils/Client.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE ScopedTypeVariables #-}
 module Servant.Utils.Client where
 
 import Control.Applicative
@@ -6,6 +7,10 @@ import Control.Monad
 import Control.Monad.IO.Class
 import Control.Monad.Trans.Either
 import Data.Aeson
+import Data.Aeson.Parser
+import Data.Aeson.Types
+import Data.Attoparsec.ByteString
+import Data.ByteString.Lazy
 import Data.String.Conversions
 import Network.HTTP.Types
 import Network.URI
@@ -32,8 +37,10 @@ performRequest method req wantedStatus host = do
       let status = Client.responseStatus response
       when (statusCode status /= wantedStatus) $
         left (requestString ++ " failed with status: " ++ showStatus status)
-      result <- maybe (left (requestString ++ " returned invalid json")) return $
+      result <- either
-        decode' (Client.responseBody response)
+        (\ message -> left (requestString ++ " returned invalid json: " ++ message))
+        return
+        (decodeLenient (Client.responseBody response))
       return result
   where
     requestString = "HTTP " ++ cs method ++ " request"
@@ -46,3 +53,10 @@ catchStatusCodeException action = catch (Right <$> action) $
     Client.StatusCodeException status _ _ ->
       return $ Left status
     e -> throwIO e
+
+-- | Like 'Data.Aeson.decode' but allows all JSON values instead of just
+-- objects and arrays.
+decodeLenient :: FromJSON a => ByteString -> Either String a
+decodeLenient input = do
+  v :: Value <- parseOnly (Data.Aeson.Parser.value <* endOfInput) (cs input)
+  parseEither parseJSON v

test/Servant/ClientSpec.hs

@@ -8,12 +8,14 @@ module Servant.ClientSpec where
 import Control.Concurrent
 import Control.Exception
 import Control.Monad.Trans.Either
+import Data.Foldable
 import Data.Proxy
 import Data.Typeable
 import Network.Socket
 import Network.URI
 import Network.Wai
 import Network.Wai.Handler.Warp
+import Prelude hiding (mapM_)
 import Test.Hspec
 
 import Servant.API
@@ -28,6 +30,7 @@ type Api =
   :<|> "body" :> ReqBody Person :> Post Person
   :<|> "param" :> QueryParam "name" String :> Get Person
   :<|> "params" :> QueryParams "names" String :> Get [Person]
+  :<|> "flag" :> QueryFlag "flag" :> Get Bool
 api :: Proxy Api
 api = Proxy
 
@@ -41,6 +44,7 @@ server = serve api (
                    Just name -> left (400, name ++ " not found")
                    Nothing -> left (400, "missing parameter"))
   :<|> (\ names -> return (zipWith Person names [0..]))
+  :<|> return
  )
 
 withServer :: (URIAuth -> IO a) -> IO a
@@ -51,11 +55,13 @@ getCapture :: String -> URIAuth -> EitherT String IO Person
 getBody :: Person -> URIAuth -> EitherT String IO Person
 getQueryParam :: Maybe String -> URIAuth -> EitherT String IO Person
 getQueryParams :: [String] -> URIAuth -> EitherT String IO [Person]
+getQueryFlag :: Bool -> URIAuth -> EitherT String IO Bool
 (     getGet
  :<|> getCapture
  :<|> getBody
  :<|> getQueryParam
- :<|> getQueryParams)
+ :<|> getQueryParams
+ :<|> getQueryFlag)
     = client api
 
 spec :: Spec
@@ -80,6 +86,12 @@ spec = do
     runEitherT (getQueryParams ["alice", "bob"] host)
       `shouldReturn` Right [Person "alice" 0, Person "bob" 1]
 
+  context "Servant.API.QueryParam.QueryFlag" $
+    forM_ [False, True] $ \ flag ->
+    it (show flag) $ withServer $ \ host -> do
+      runEitherT (getQueryFlag flag host) `shouldReturn` Right flag
+
+
   context "client correctly handles error status codes" $ do
     let test :: WrappedApi -> Spec
         test (WrappedApi api) =