16dbf9b · typeable/servant

git.iko.soy/typeable/servant

Allow arbitrary JSON values (not only arrays and objects)

And added tests for QueryFlag.

commit16dbf9b188ee80baf46a6d9d47aa39669b56126f authorSönke Hahn <soenkehahn@gmail.com> dateFri 31 Oct 2014, 20:29 (12 years ago) parentc2be4f3

3 files changed+30−3

compare with master

unifiedsplit

servant.cabal+1 src/Servant/Utils/Client.hs+16−2 test/Servant/ClientSpec.hs+13−1

servant.cabal+1

@@ -35,6 +35,7 @@ library

3535 base >=4.7 && <5

3636 , either

3737 , aeson

38+ , attoparsec

3839 , bytestring

3940 , exceptions

4041 , string-conversions

src/Servant/Utils/Client.hs+16−2

@@ -1,3 +1,4 @@

1+{-# LANGUAGE ScopedTypeVariables #-}

12module Servant.Utils.Client where

34import Control.Applicative

@@ -6,6 +7,10 @@ import Control.Monad

67import Control.Monad.IO.Class

78import Control.Monad.Trans.Either

89import Data.Aeson

10+import Data.Aeson.Parser

11+import Data.Aeson.Types

12+import Data.Attoparsec.ByteString

13+import Data.ByteString.Lazy

914import Data.String.Conversions

1015import Network.HTTP.Types

1116import Network.URI

@@ -32,8 +37,10 @@ performRequest method req wantedStatus host = do

3237 let status = Client.responseStatus response

3338 when (statusCode status /= wantedStatus) $

3439 left (requestString ++ " failed with status: " ++ showStatus status)

35− result <- maybe (left (requestString ++ " returned invalid json")) return $

36− decode' (Client.responseBody response)

40+ result <- either

41+ (\ message -> left (requestString ++ " returned invalid json: " ++ message))

42+ return

43+ (decodeLenient (Client.responseBody response))

3744 return result

3845 where

3946 requestString = "HTTP " ++ cs method ++ " request"

@@ -46,3 +53,10 @@ catchStatusCodeException action = catch (Right <$> action) $

4653 Client.StatusCodeException status _ _ ->

4754 return $ Left status

4855 e -> throwIO e

56+

57+-- | Like 'Data.Aeson.decode' but allows all JSON values instead of just

58+-- objects and arrays.

59+decodeLenient :: FromJSON a => ByteString -> Either String a

60+decodeLenient input = do

61+ v :: Value <- parseOnly (Data.Aeson.Parser.value <* endOfInput) (cs input)

62+ parseEither parseJSON v

test/Servant/ClientSpec.hs+13−1

@@ -8,12 +8,14 @@ module Servant.ClientSpec where

88import Control.Concurrent

99import Control.Exception

1010import Control.Monad.Trans.Either

11+import Data.Foldable

1112import Data.Proxy

1213import Data.Typeable

1314import Network.Socket

1415import Network.URI

1516import Network.Wai

1617import Network.Wai.Handler.Warp

18+import Prelude hiding (mapM_)

1719import Test.Hspec

1820

1921import Servant.API

@@ -28,6 +30,7 @@ type Api =

2830 :<|> "body" :> ReqBody Person :> Post Person

2931 :<|> "param" :> QueryParam "name" String :> Get Person

3032 :<|> "params" :> QueryParams "names" String :> Get [Person]

33+ :<|> "flag" :> QueryFlag "flag" :> Get Bool

3134api :: Proxy Api

3235api = Proxy

3336

@@ -41,6 +44,7 @@ server = serve api (

4144 Just name -> left (400, name ++ " not found")

4245 Nothing -> left (400, "missing parameter"))

4346 :<|> (\ names -> return (zipWith Person names [0..]))

47+ :<|> return

4448 )

4549

4650withServer :: (URIAuth -> IO a) -> IO a

@@ -51,11 +55,13 @@ getCapture :: String -> URIAuth -> EitherT String IO Person

5155getBody :: Person -> URIAuth -> EitherT String IO Person

5256getQueryParam :: Maybe String -> URIAuth -> EitherT String IO Person

5357getQueryParams :: [String] -> URIAuth -> EitherT String IO [Person]

58+getQueryFlag :: Bool -> URIAuth -> EitherT String IO Bool

5459( getGet

5560 :<|> getCapture

5661 :<|> getBody

5762 :<|> getQueryParam

58− :<|> getQueryParams)

63+ :<|> getQueryParams

64+ :<|> getQueryFlag)

5965 = client api

6066

6167spec :: Spec

@@ -80,6 +86,12 @@ spec = do

8086 runEitherT (getQueryParams ["alice", "bob"] host)

8187 `shouldReturn` Right [Person "alice" 0, Person "bob" 1]

8288

89+ context "Servant.API.QueryParam.QueryFlag" $

90+ forM_ [False, True] $ \ flag ->

91+ it (show flag) $ withServer $ \ host -> do

92+ runEitherT (getQueryFlag flag host) `shouldReturn` Right flag

93+

94+

8395 context "client correctly handles error status codes" $ do

8496 let test :: WrappedApi -> Spec

8597 test (WrappedApi api) =