270 lines
7.4 KiB
Haskell
270 lines
7.4 KiB
Haskell
{-# LANGUAGE DataKinds #-}
|
|
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE QuasiQuotes #-}
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
{-# LANGUAGE TypeOperators #-}
|
|
|
|
module Servant.ServerSpec where
|
|
|
|
|
|
import Control.Monad.Trans.Either
|
|
import Data.Aeson
|
|
import Data.Char
|
|
import Data.Proxy
|
|
import Data.String
|
|
import Data.String.Conversions
|
|
import GHC.Generics
|
|
import Network.HTTP.Types
|
|
import Network.Wai
|
|
import Network.Wai.Test
|
|
import Test.Hspec
|
|
import Test.Hspec.Wai
|
|
|
|
import Servant.API.Capture
|
|
import Servant.API.Get
|
|
import Servant.API.ReqBody
|
|
import Servant.API.Post
|
|
import Servant.API.QueryParam
|
|
import Servant.API.Raw
|
|
import Servant.API.Sub
|
|
import Servant.API.Alternative
|
|
import Servant.Server
|
|
|
|
|
|
-- * test data types
|
|
|
|
data Person = Person {
|
|
name :: String,
|
|
age :: Integer
|
|
}
|
|
deriving (Eq, Show, Generic)
|
|
|
|
instance ToJSON Person
|
|
instance FromJSON Person
|
|
|
|
alice :: Person
|
|
alice = Person "Alice" 42
|
|
|
|
data Animal = Animal {
|
|
species :: String,
|
|
numberOfLegs :: Integer
|
|
}
|
|
deriving (Eq, Show, Generic)
|
|
|
|
instance ToJSON Animal
|
|
instance FromJSON Animal
|
|
|
|
jerry :: Animal
|
|
jerry = Animal "Mouse" 4
|
|
|
|
tweety :: Animal
|
|
tweety = Animal "Bird" 2
|
|
|
|
|
|
-- * specs
|
|
|
|
spec :: Spec
|
|
spec = do
|
|
captureSpec
|
|
getSpec
|
|
queryParamSpec
|
|
postSpec
|
|
rawSpec
|
|
unionSpec
|
|
|
|
|
|
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]))
|
|
|
|
|
|
type GetApi = Get Person
|
|
getApi :: Proxy GetApi
|
|
getApi = Proxy
|
|
|
|
getSpec :: Spec
|
|
getSpec = do
|
|
describe "Servant.API.Get" $ do
|
|
with (return (serve getApi (return alice))) $ do
|
|
it "allows to GET a Person" $ do
|
|
response <- get "/"
|
|
return response `shouldRespondWith` 200
|
|
liftIO $ do
|
|
decode' (simpleBody response) `shouldBe` Just alice
|
|
|
|
it "throws 405 (wrong method) on POSTs" $ do
|
|
post "/" "" `shouldRespondWith` 405
|
|
|
|
|
|
type QueryParamApi = QueryParam "name" String :> Get Person
|
|
:<|> "a" :> QueryParams "names" String :> Get Person
|
|
:<|> "b" :> QueryFlag "capitalize" :> Get Person
|
|
|
|
queryParamApi :: Proxy QueryParamApi
|
|
queryParamApi = Proxy
|
|
|
|
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
|
|
|
|
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
|
|
}
|
|
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{
|
|
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"
|
|
}
|
|
|
|
type PostApi =
|
|
ReqBody Person :> Post Integer
|
|
:<|> "bla" :> ReqBody Person :> Post Integer
|
|
postApi :: Proxy PostApi
|
|
postApi = Proxy
|
|
|
|
postSpec :: Spec
|
|
postSpec = do
|
|
describe "Servant.API.Post and .ReqBody" $ do
|
|
with (return (serve postApi (return . age :<|> return . age))) $ do
|
|
it "allows to POST a Person" $ do
|
|
post "/" (encode alice) `shouldRespondWith` "42"{
|
|
matchStatus = 201
|
|
}
|
|
|
|
it "allows alternative routes if all have request bodies" $ do
|
|
post "/bla" (encode alice) `shouldRespondWith` "42"{
|
|
matchStatus = 201
|
|
}
|
|
|
|
it "handles trailing '/' gracefully" $ do
|
|
post "/bla/" (encode alice) `shouldRespondWith` "42"{
|
|
matchStatus = 201
|
|
}
|
|
|
|
it "correctly rejects invalid request bodies with status 400" $ do
|
|
post "/" "some invalid body" `shouldRespondWith` 400
|
|
|
|
|
|
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])
|
|
|
|
|
|
type AlternativeApi =
|
|
"foo" :> Get Person
|
|
:<|> "bar" :> Get Animal
|
|
unionApi :: Proxy AlternativeApi
|
|
unionApi = Proxy
|
|
|
|
unionServer :: Server AlternativeApi
|
|
unionServer =
|
|
return alice
|
|
:<|> return jerry
|
|
|
|
unionSpec :: Spec
|
|
unionSpec = do
|
|
describe "Servant.API.Alternative" $ do
|
|
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
|