add tests for QueryParams and QueryFlag
This commit is contained in:
parent
bab2bc7edf
commit
e774af7707
1 changed files with 50 additions and 13 deletions
|
@ -10,6 +10,7 @@ module Servant.ServerSpec where
|
||||||
|
|
||||||
import Control.Monad.Trans.Either
|
import Control.Monad.Trans.Either
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
|
import Data.Char
|
||||||
import Data.Proxy
|
import Data.Proxy
|
||||||
import Data.String
|
import Data.String
|
||||||
import Data.String.Conversions
|
import Data.String.Conversions
|
||||||
|
@ -118,28 +119,64 @@ getSpec = do
|
||||||
|
|
||||||
|
|
||||||
type QueryParamApi = QueryParam "name" String :> Get Person
|
type QueryParamApi = QueryParam "name" String :> Get Person
|
||||||
|
:<|> "a" :> QueryParams "names" String :> Get Person
|
||||||
|
:<|> "b" :> QueryFlag "capitalize" :> Get Person
|
||||||
|
|
||||||
queryParamApi :: Proxy QueryParamApi
|
queryParamApi :: Proxy QueryParamApi
|
||||||
queryParamApi = Proxy
|
queryParamApi = Proxy
|
||||||
|
|
||||||
queryParamServer :: Server QueryParamApi
|
qpServer :: Server QueryParamApi
|
||||||
|
qpServer = queryParamServer :<|> qpNames :<|> qpCapitalize
|
||||||
|
|
||||||
|
where qpNames (_:name2:_) = return alice { name = name2 }
|
||||||
|
qpNames _ = return alice
|
||||||
|
|
||||||
|
qpCapitalize False = return alice
|
||||||
|
qpCapitalize True = return alice { name = map toUpper (name alice) }
|
||||||
|
|
||||||
queryParamServer (Just name) = return alice{name = name}
|
queryParamServer (Just name) = return alice{name = name}
|
||||||
queryParamServer Nothing = return alice
|
queryParamServer Nothing = return alice
|
||||||
|
|
||||||
queryParamSpec :: Spec
|
queryParamSpec :: Spec
|
||||||
queryParamSpec = do
|
queryParamSpec = do
|
||||||
describe "Servant.API.QueryParam" $ do
|
describe "Servant.API.QueryParam" $ do
|
||||||
it "allows to retrieve GET parameters" $ do
|
it "allows to retrieve simple GET parameters" $
|
||||||
(flip runSession) (serve queryParamApi queryParamServer) $ do
|
(flip runSession) (serve queryParamApi qpServer) $ do
|
||||||
let params = "?name=bob"
|
let params1 = "?name=bob"
|
||||||
response <- Network.Wai.Test.request defaultRequest{
|
response1 <- Network.Wai.Test.request defaultRequest{
|
||||||
rawQueryString = params,
|
rawQueryString = params1,
|
||||||
queryString = parseQuery params
|
queryString = parseQuery params1
|
||||||
}
|
}
|
||||||
liftIO $ do
|
liftIO $ do
|
||||||
decode' (simpleBody response) `shouldBe` Just alice{
|
decode' (simpleBody response1) `shouldBe` Just alice{
|
||||||
name = "bob"
|
name = "bob"
|
||||||
}
|
}
|
||||||
|
|
||||||
|
it "allows to retrieve lists in GET parameters" $
|
||||||
|
(flip runSession) (serve queryParamApi qpServer) $ do
|
||||||
|
let params2 = "?names[]=bob&names[]=john"
|
||||||
|
response2 <- Network.Wai.Test.request defaultRequest{
|
||||||
|
rawQueryString = params2,
|
||||||
|
queryString = parseQuery params2,
|
||||||
|
pathInfo = ["a"]
|
||||||
|
}
|
||||||
|
liftIO $
|
||||||
|
decode' (simpleBody response2) `shouldBe` Just alice{
|
||||||
|
name = "john"
|
||||||
|
}
|
||||||
|
|
||||||
|
it "allows to retrieve value-less GET parameters" $
|
||||||
|
(flip runSession) (serve queryParamApi qpServer) $ do
|
||||||
|
let params3 = "?capitalize"
|
||||||
|
response3 <- Network.Wai.Test.request defaultRequest{
|
||||||
|
rawQueryString = params3,
|
||||||
|
queryString = parseQuery params3,
|
||||||
|
pathInfo = ["b"]
|
||||||
|
}
|
||||||
|
liftIO $
|
||||||
|
decode' (simpleBody response3) `shouldBe` Just alice{
|
||||||
|
name = "ALICE"
|
||||||
|
}
|
||||||
|
|
||||||
type PostApi = ReqBody Person :> Post Integer
|
type PostApi = ReqBody Person :> Post Integer
|
||||||
postApi :: Proxy PostApi
|
postApi :: Proxy PostApi
|
||||||
|
|
Loading…
Add table
Reference in a new issue