on master help sign in
Extend tests and clean up
da0e1caTimo von Holtz
servant-client.cabal+1
@@ -78,5 +78,6 @@ test-suite spec
78 , servant >= 0.2.1
78 , servant >= 0.2.1
79 , servant-client
79 , servant-client
80 , servant-server >= 0.2.1
80 , servant-server >= 0.2.1
81+ , text
81 , wai
82 , wai
82 , warp
83 , warp
src/Servant/Common/Req.hs−4
@@ -9,10 +9,6 @@ import Control.Monad
9import Control.Monad.Catch (MonadThrow)
9import Control.Monad.Catch (MonadThrow)
10import Control.Monad.IO.Class
10import Control.Monad.IO.Class
11import Control.Monad.Trans.Either
11import Control.Monad.Trans.Either
12−import Data.Aeson
13−import Data.Aeson.Parser
14−import Data.Aeson.Types
15−import Data.Attoparsec.ByteString
16import Data.ByteString.Lazy hiding (pack, filter, map, null)
12import Data.ByteString.Lazy hiding (pack, filter, map, null)
17import Data.String
13import Data.String
18import Data.String.Conversions
14import Data.String.Conversions
test/Servant/ClientSpec.hs+22−12
@@ -3,6 +3,7 @@
3{-# LANGUAGE ViewPatterns #-}
3{-# LANGUAGE ViewPatterns #-}
4{-# LANGUAGE DeriveGeneric #-}
4{-# LANGUAGE DeriveGeneric #-}
5{-# LANGUAGE TypeOperators #-}
5{-# LANGUAGE TypeOperators #-}
6+{-# LANGUAGE RecordWildCards #-}
6{-# LANGUAGE OverloadedStrings #-}
7{-# LANGUAGE OverloadedStrings #-}
7{-# OPTIONS_GHC -fcontext-stack=25 #-}
8{-# OPTIONS_GHC -fcontext-stack=25 #-}
8module Servant.ClientSpec where
9module Servant.ClientSpec where
@@ -14,8 +15,9 @@ import Data.Aeson
14import Data.ByteString.Lazy (ByteString)
15import Data.ByteString.Lazy (ByteString)
15import Data.Char
16import Data.Char
16import Data.Foldable (forM_)
17import Data.Foldable (forM_)
18+import Data.Monoid
17import Data.Proxy
19import Data.Proxy
18−import Data.Typeable
20+import qualified Data.Text as T
19import GHC.Generics
21import GHC.Generics
20import Network.HTTP.Media
22import Network.HTTP.Media
21import Network.HTTP.Types
23import Network.HTTP.Types
@@ -27,6 +29,7 @@ import Test.Hspec.QuickCheck
27import Test.QuickCheck
29import Test.QuickCheck
28
30
29import Servant.API
31import Servant.API
32+import Servant.API.ContentTypes
30import Servant.Client
33import Servant.Client
31import Servant.Server
34import Servant.Server
32
35
@@ -41,22 +44,35 @@ data Person = Person {
41instance ToJSON Person
44instance ToJSON Person
42instance FromJSON Person
45instance FromJSON Person
43
46
47+instance ToFormUrlEncoded Person where
48+ toFormUrlEncoded Person{..} =
49+ [("name", T.pack name), ("age", T.pack (show age))]
50+
51+lookupEither :: (Show a, Eq a) => a -> [(a,b)] -> Either String b
52+lookupEither x xs = do
53+ maybe (Left $ "could not find key " <> show x) return $ lookup x xs
54+
55+instance FromFormUrlEncoded Person where
56+ fromFormUrlEncoded xs = do
57+ n <- lookupEither "name" xs
58+ a <- lookupEither "age" xs
59+ return $ Person (T.unpack n) (read $ T.unpack a)
60+
61+
44alice :: Person
62alice :: Person
45alice = Person "Alice" 42
63alice = Person "Alice" 42
46
64
47type Api =
65type Api =
48 "get" :> Get '[JSON] Person
66 "get" :> Get '[JSON] Person
49 :<|> "delete" :> Delete
67 :<|> "delete" :> Delete
50− :<|> "capture" :> Capture "name" String :> Get '[JSON] Person
68+ :<|> "capture" :> Capture "name" String :> Get '[JSON,FormUrlEncoded] Person
51− :<|> "body" :> ReqBody '[JSON] Person :> Post '[JSON] Person
69+ :<|> "body" :> ReqBody '[FormUrlEncoded,JSON] Person :> Post '[JSON] Person
52− :<|> "param" :> QueryParam "name" String :> Get '[JSON] Person
70+ :<|> "param" :> QueryParam "name" String :> Get '[FormUrlEncoded,JSON] Person
53 :<|> "params" :> QueryParams "names" String :> Get '[JSON] [Person]
71 :<|> "params" :> QueryParams "names" String :> Get '[JSON] [Person]
54 :<|> "flag" :> QueryFlag "flag" :> Get '[JSON] Bool
72 :<|> "flag" :> QueryFlag "flag" :> Get '[JSON] Bool
55−{-
56 :<|> "matrixparam" :> MatrixParam "name" String :> Get '[JSON] Person
73 :<|> "matrixparam" :> MatrixParam "name" String :> Get '[JSON] Person
57 :<|> "matrixparams" :> MatrixParams "name" String :> Get '[JSON] [Person]
74 :<|> "matrixparams" :> MatrixParams "name" String :> Get '[JSON] [Person]
58 :<|> "matrixflag" :> MatrixFlag "flag" :> Get '[JSON] Bool
75 :<|> "matrixflag" :> MatrixFlag "flag" :> Get '[JSON] Bool
59−-}
60 :<|> "rawSuccess" :> Raw
76 :<|> "rawSuccess" :> Raw
61 :<|> "rawFailure" :> Raw
77 :<|> "rawFailure" :> Raw
62 :<|> "multiple" :>
78 :<|> "multiple" :>
@@ -80,14 +96,12 @@ server = serve api (
80 Nothing -> left (400, "missing parameter"))
96 Nothing -> left (400, "missing parameter"))
81 :<|> (\ names -> return (zipWith Person names [0..]))
97 :<|> (\ names -> return (zipWith Person names [0..]))
82 :<|> return
98 :<|> return
83−{-
84 :<|> (\ name -> case name of
99 :<|> (\ name -> case name of
85 Just "alice" -> return alice
100 Just "alice" -> return alice
86 Just name -> left (400, name ++ " not found")
101 Just name -> left (400, name ++ " not found")
87 Nothing -> left (400, "missing parameter"))
102 Nothing -> left (400, "missing parameter"))
88 :<|> (\ names -> return (zipWith Person names [0..]))
103 :<|> (\ names -> return (zipWith Person names [0..]))
89 :<|> return
104 :<|> return
90−-}
91 :<|> (\ _request respond -> respond $ responseLBS ok200 [] "rawSuccess")
105 :<|> (\ _request respond -> respond $ responseLBS ok200 [] "rawSuccess")
92 :<|> (\ _request respond -> respond $ responseLBS badRequest400 [] "rawFailure")
106 :<|> (\ _request respond -> respond $ responseLBS badRequest400 [] "rawFailure")
93 :<|> \ a b c d -> return (a, b, c, d)
107 :<|> \ a b c d -> return (a, b, c, d)
@@ -103,11 +117,9 @@ getBody :: Person -> BaseUrl -> EitherT String IO Person
103getQueryParam :: Maybe String -> BaseUrl -> EitherT String IO Person
117getQueryParam :: Maybe String -> BaseUrl -> EitherT String IO Person
104getQueryParams :: [String] -> BaseUrl -> EitherT String IO [Person]
118getQueryParams :: [String] -> BaseUrl -> EitherT String IO [Person]
105getQueryFlag :: Bool -> BaseUrl -> EitherT String IO Bool
119getQueryFlag :: Bool -> BaseUrl -> EitherT String IO Bool
106−{-
107getMatrixParam :: Maybe String -> BaseUrl -> EitherT String IO Person
120getMatrixParam :: Maybe String -> BaseUrl -> EitherT String IO Person
108getMatrixParams :: [String] -> BaseUrl -> EitherT String IO [Person]
121getMatrixParams :: [String] -> BaseUrl -> EitherT String IO [Person]
109getMatrixFlag :: Bool -> BaseUrl -> EitherT String IO Bool
122getMatrixFlag :: Bool -> BaseUrl -> EitherT String IO Bool
110−-}
111getRawSuccess :: Method -> BaseUrl -> EitherT String IO (Int, ByteString, MediaType)
123getRawSuccess :: Method -> BaseUrl -> EitherT String IO (Int, ByteString, MediaType)
112getRawFailure :: Method -> BaseUrl -> EitherT String IO (Int, ByteString, MediaType)
124getRawFailure :: Method -> BaseUrl -> EitherT String IO (Int, ByteString, MediaType)
113getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]
125getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]
@@ -120,11 +132,9 @@ getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]
120 :<|> getQueryParam
132 :<|> getQueryParam
121 :<|> getQueryParams
133 :<|> getQueryParams
122 :<|> getQueryFlag
134 :<|> getQueryFlag
123−{-
124 :<|> getMatrixParam
135 :<|> getMatrixParam
125 :<|> getMatrixParams
136 :<|> getMatrixParams
126 :<|> getMatrixFlag
137 :<|> getMatrixFlag
127−-}
128 :<|> getRawSuccess
138 :<|> getRawSuccess
129 :<|> getRawFailure
139 :<|> getRawFailure
130 :<|> getMultiple)
140 :<|> getMultiple)