@@ -3,6 +3,7 @@
33{-# LANGUAGE ViewPatterns #-}
44{-# LANGUAGE DeriveGeneric #-}
55{-# LANGUAGE TypeOperators #-}
6+{-# LANGUAGE RecordWildCards #-}
67{-# LANGUAGE OverloadedStrings #-}
78{-# OPTIONS_GHC -fcontext-stack=25 #-}
89module Servant.ClientSpec where
@@ -14,8 +15,9 @@ import Data.Aeson
1415import Data.ByteString.Lazy (ByteString)
1516import Data.Char
1617import Data.Foldable (forM_)
18+import Data.Monoid
1719import Data.Proxy
18−import Data.Typeable
20+import qualified Data.Text as T
1921import GHC.Generics
2022import Network.HTTP.Media
2123import Network.HTTP.Types
@@ -27,6 +29,7 @@ import Test.Hspec.QuickCheck
2729import Test.QuickCheck
2830
2931import Servant.API
32+import Servant.API.ContentTypes
3033import Servant.Client
3134import Servant.Server
3235
@@ -41,22 +44,35 @@ data Person = Person {
4144instance ToJSON Person
4245instance FromJSON Person
4346
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+
4462alice :: Person
4563alice = Person "Alice" 42
4664
4765type Api =
4866 "get" :> Get '[JSON] Person
4967 :<|> "delete" :> Delete
50− :<|> "capture" :> Capture "name" String :> Get '[JSON] Person
51− :<|> "body" :> ReqBody '[JSON] Person :> Post '[JSON] Person
52− :<|> "param" :> QueryParam "name" String :> Get '[JSON] Person
68+ :<|> "capture" :> Capture "name" String :> Get '[JSON,FormUrlEncoded] Person
69+ :<|> "body" :> ReqBody '[FormUrlEncoded,JSON] Person :> Post '[JSON] Person
70+ :<|> "param" :> QueryParam "name" String :> Get '[FormUrlEncoded,JSON] Person
5371 :<|> "params" :> QueryParams "names" String :> Get '[JSON] [Person]
5472 :<|> "flag" :> QueryFlag "flag" :> Get '[JSON] Bool
55−{-
5673 :<|> "matrixparam" :> MatrixParam "name" String :> Get '[JSON] Person
5774 :<|> "matrixparams" :> MatrixParams "name" String :> Get '[JSON] [Person]
5875 :<|> "matrixflag" :> MatrixFlag "flag" :> Get '[JSON] Bool
59−-}
6076 :<|> "rawSuccess" :> Raw
6177 :<|> "rawFailure" :> Raw
6278 :<|> "multiple" :>
@@ -80,14 +96,12 @@ server = serve api (
8096 Nothing -> left (400, "missing parameter"))
8197 :<|> (\ names -> return (zipWith Person names [0..]))
8298 :<|> return
83−{-
8499 :<|> (\ name -> case name of
85100 Just "alice" -> return alice
86101 Just name -> left (400, name ++ " not found")
87102 Nothing -> left (400, "missing parameter"))
88103 :<|> (\ names -> return (zipWith Person names [0..]))
89104 :<|> return
90−-}
91105 :<|> (\ _request respond -> respond $ responseLBS ok200 [] "rawSuccess")
92106 :<|> (\ _request respond -> respond $ responseLBS badRequest400 [] "rawFailure")
93107 :<|> \ a b c d -> return (a, b, c, d)
@@ -103,11 +117,9 @@ getBody :: Person -> BaseUrl -> EitherT String IO Person
103117getQueryParam :: Maybe String -> BaseUrl -> EitherT String IO Person
104118getQueryParams :: [String] -> BaseUrl -> EitherT String IO [Person]
105119getQueryFlag :: Bool -> BaseUrl -> EitherT String IO Bool
106−{-
107120getMatrixParam :: Maybe String -> BaseUrl -> EitherT String IO Person
108121getMatrixParams :: [String] -> BaseUrl -> EitherT String IO [Person]
109122getMatrixFlag :: Bool -> BaseUrl -> EitherT String IO Bool
110−-}
111123getRawSuccess :: Method -> BaseUrl -> EitherT String IO (Int, ByteString, MediaType)
112124getRawFailure :: Method -> BaseUrl -> EitherT String IO (Int, ByteString, MediaType)
113125getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]
@@ -120,11 +132,9 @@ getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]
120132 :<|> getQueryParam
121133 :<|> getQueryParams
122134 :<|> getQueryFlag
123−{-
124135 :<|> getMatrixParam
125136 :<|> getMatrixParams
126137 :<|> getMatrixFlag
127−-}
128138 :<|> getRawSuccess
129139 :<|> getRawFailure
130140 :<|> getMultiple)