servant/test/Servant/ServerSpec.hs

262 lines
7.1 KiB
Haskell
Raw Normal View History

2014-10-27 08:10:48 +01:00
{-# LANGUAGE DataKinds #-}
2014-10-27 07:24:23 +01:00
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
2014-10-27 08:10:48 +01:00
{-# LANGUAGE TypeOperators #-}
2014-10-27 07:24:23 +01:00
module Servant.ServerSpec where
2014-10-28 07:00:01 +01:00
import Control.Monad.Trans.Either
2014-10-27 07:24:23 +01:00
import Data.Aeson
import Data.Char
2014-10-27 07:24:23 +01:00
import Data.Proxy
import Data.String
import Data.String.Conversions
2014-10-27 07:24:23 +01:00
import GHC.Generics
2014-10-27 09:24:56 +01:00
import Network.HTTP.Types
import Network.Wai
2014-10-27 07:24:23 +01:00
import Network.Wai.Test
import Test.Hspec
2014-10-27 09:24:56 +01:00
import Test.Hspec.Wai
2014-10-27 07:24:23 +01:00
2014-10-28 07:00:01 +01:00
import Servant.API.Capture
2014-10-27 07:24:23 +01:00
import Servant.API.Get
import Servant.API.ReqBody
2014-10-27 08:10:48 +01:00
import Servant.API.Post
import Servant.API.QueryParam
import Servant.API.Raw
2014-10-27 08:10:48 +01:00
import Servant.API.Sub
2014-10-30 11:37:58 +01:00
import Servant.API.Alternative
import Servant.Docs
2014-10-27 07:24:23 +01:00
import Servant.Server
2014-10-27 08:52:18 +01:00
-- * test data types
2014-10-27 07:24:23 +01:00
data Person = Person {
name :: String,
age :: Integer
}
deriving (Eq, Show, Generic)
instance ToJSON Person
instance FromJSON Person
instance ToSample Person where
toSample _proxy = Just $ encode alice
2014-10-27 07:24:23 +01:00
alice :: Person
2014-10-27 08:10:48 +01:00
alice = Person "Alice" 42
2014-10-27 07:24:23 +01:00
2014-10-27 08:52:18 +01:00
data Animal = Animal {
species :: String,
numberOfLegs :: Integer
}
deriving (Eq, Show, Generic)
instance ToJSON Animal
instance FromJSON Animal
jerry :: Animal
jerry = Animal "Mouse" 4
2014-10-28 07:00:01 +01:00
tweety :: Animal
tweety = Animal "Bird" 2
2014-10-27 08:52:18 +01:00
-- * specs
2014-10-27 07:24:23 +01:00
spec :: Spec
spec = do
2014-10-28 07:00:01 +01:00
captureSpec
2014-10-27 07:24:23 +01:00
getSpec
queryParamSpec
2014-10-27 08:10:48 +01:00
postSpec
rawSpec
2014-10-27 08:52:18 +01:00
unionSpec
2014-10-27 07:24:23 +01:00
2014-10-28 07:00:01 +01:00
type CaptureApi = Capture "legs" Integer :> Get Animal
captureApi :: Proxy CaptureApi
captureApi = Proxy
captureServer :: Integer -> EitherT (Int, String) IO Animal
captureServer legs = case legs of
4 -> return jerry
2 -> return tweety
_ -> left (404, "not found")
captureSpec :: Spec
captureSpec = do
describe "Servant.API.Capture" $ do
with (return (serve captureApi captureServer)) $ do
it "can capture parts of the 'pathInfo'" $ do
response <- get "/2"
liftIO $ do
decode' (simpleBody response) `shouldBe` Just tweety
with (return (serve
(Proxy :: Proxy (Capture "captured" String :> Raw))
(\ "captured" request respond ->
respond $ responseLBS ok200 [] (cs $ show $ pathInfo request)))) $ do
it "strips the captured path snippet from pathInfo" $ do
get "/captured/foo" `shouldRespondWith` (fromString (show ["foo" :: String]))
2014-10-28 07:00:01 +01:00
2014-10-27 07:24:23 +01:00
type GetApi = Get Person
getApi :: Proxy GetApi
getApi = Proxy
getSpec :: Spec
getSpec = do
2014-10-27 07:24:23 +01:00
describe "Servant.API.Get" $ do
with (return (serve getApi (return alice))) $ do
2014-10-27 08:10:48 +01:00
it "allows to GET a Person" $ do
2014-10-27 07:24:23 +01:00
response <- get "/"
return response `shouldRespondWith` 200
liftIO $ do
decode' (simpleBody response) `shouldBe` Just alice
2014-10-27 08:10:48 +01:00
it "throws 405 (wrong method) on POSTs" $ do
post "/" "" `shouldRespondWith` 405
2014-10-27 08:10:48 +01:00
type QueryParamApi = QueryParam "name" String :> Get Person
:<|> "a" :> QueryParams "names" String :> Get Person
:<|> "b" :> QueryFlag "capitalize" :> Get Person
queryParamApi :: Proxy QueryParamApi
queryParamApi = Proxy
2014-10-27 09:24:56 +01:00
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 Nothing = return alice
2014-10-27 09:24:56 +01:00
queryParamSpec :: Spec
queryParamSpec = do
describe "Servant.API.QueryParam" $ do
it "allows to retrieve simple GET parameters" $
(flip runSession) (serve queryParamApi qpServer) $ do
let params1 = "?name=bob"
response1 <- Network.Wai.Test.request defaultRequest{
rawQueryString = params1,
queryString = parseQuery params1
2014-10-27 09:24:56 +01:00
}
liftIO $ do
decode' (simpleBody response1) `shouldBe` Just alice{
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{
2014-10-31 13:01:12 +01:00
name = "ALICE"
}
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"
}
2014-10-27 09:24:56 +01:00
type PostApi = ReqBody Person :> Post Integer
2014-10-27 08:10:48 +01:00
postApi :: Proxy PostApi
postApi = Proxy
postSpec :: Spec
postSpec = do
describe "Servant.API.Post and .ReqBody" $ do
2014-10-27 08:10:48 +01:00
with (return (serve postApi (return . age))) $ do
it "allows to POST a Person" $ do
post "/" (encode alice) `shouldRespondWith` "42"{
matchStatus = 201
}
2014-10-27 08:52:18 +01:00
it "correctly rejects invalid request bodies with status 400" $ do
post "/" "some invalid body" `shouldRespondWith` 400
2014-10-27 08:52:18 +01:00
type RawApi = "foo" :> Raw
rawApi :: Proxy RawApi
rawApi = Proxy
rawApplication :: Show a => (Request -> a) -> Application
rawApplication f request respond = respond $ responseLBS ok200 [] (cs $ show $ f request)
rawSpec :: Spec
rawSpec = do
describe "Servant.API.Raw" $ do
it "runs applications" $ do
(flip runSession) (serve rawApi (rawApplication (const (42 :: Integer)))) $ do
response <- Network.Wai.Test.request defaultRequest{
pathInfo = ["foo"]
}
liftIO $ do
simpleBody response `shouldBe` "42"
it "gets the pathInfo modified" $ do
(flip runSession) (serve rawApi (rawApplication pathInfo)) $ do
response <- Network.Wai.Test.request defaultRequest{
pathInfo = ["foo", "bar"]
}
liftIO $ do
simpleBody response `shouldBe` cs (show ["bar" :: String])
2014-10-30 11:37:58 +01:00
type AlternativeApi =
2014-10-27 08:52:18 +01:00
"foo" :> Get Person
:<|> "bar" :> Get Animal
2014-10-30 11:37:58 +01:00
unionApi :: Proxy AlternativeApi
2014-10-27 08:52:18 +01:00
unionApi = Proxy
2014-10-30 11:37:58 +01:00
unionServer :: Server AlternativeApi
2014-10-27 08:52:18 +01:00
unionServer =
return alice
:<|> return jerry
unionSpec :: Spec
unionSpec = do
2014-10-30 11:37:58 +01:00
describe "Servant.API.Alternative" $ do
2014-10-27 08:52:18 +01:00
with (return $ serve unionApi unionServer) $ do
it "unions endpoints" $ do
response <- get "/foo"
liftIO $ do
decode' (simpleBody response) `shouldBe`
Just alice
response <- get "/bar"
liftIO $ do
decode' (simpleBody response) `shouldBe`
Just jerry