eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Add Config parameter.

Browse source 
This allows combinator instances to receive dynamic data that isn't
        constrained by the interface of Delayed etc.
This commit is contained in:
Julian K. Arni 2015-12-26 14:32:43 +01:00 committed by Sönke Hahn
parent 783a849c67
commit 207a807428
9 changed files with 150 additions and 68 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
servant-server/example/greet.hs
View file

@ -59,7 +59,7 @@ server = helloH :<|> postGreetH :<|> deleteGreetH
-- Turn the server into a WAI app. 'serve' is provided by servant,
-- more precisely by the Servant.Server module.
test :: Application
test = serve testApi server
test = serve testApi EmptyConfig server
-- Run the server.
--

1
servant-server/servant-server.cabal
View file

@ -37,6 +37,7 @@ library
Servant
Servant.Server
Servant.Server.Internal
Servant.Server.Internal.Config
Servant.Server.Internal.Enter
Servant.Server.Internal.Router
Servant.Server.Internal.RoutingApplication

14
servant-server/src/Servant/Server.hs
View file

@ -35,6 +35,11 @@ module Servant.Server
, generalizeNat
, tweakResponse
-- * Config
, ConfigEntry(..)
, Config(..)
, (.:)
-- * Default error type
, ServantErr(..)
-- ** 3XX
@ -96,14 +101,17 @@ import Servant.Server.Internal.Enter
-- > myApi :: Proxy MyApi
-- > myApi = Proxy
-- >
-- > cfg :: Config '[]
-- > cfg = EmptyConfig
-- >
-- > app :: Application
-- > app = serve myApi server
-- > app = serve myApi cfg server
-- >
-- > main :: IO ()
-- > main = Network.Wai.Handler.Warp.run 8080 app
--
serve :: HasServer layout => Proxy layout -> Server layout -> Application
serve p server = toApplication (runRouter (route p d))
serve :: HasServer layout => Proxy layout -> Config a -> Server layout -> Application
serve p cfg server = toApplication (runRouter (route p cfg d))
where
d = Delayed r r r (\ _ _ -> Route server)
r = return (Route ())

57
servant-server/src/Servant/Server/Internal.hs
View file

@ -13,6 +13,7 @@
module Servant.Server.Internal
( module Servant.Server.Internal
, module Servant.Server.Internal.Config
, module Servant.Server.Internal.Router
, module Servant.Server.Internal.RoutingApplication
, module Servant.Server.Internal.ServantErr
@ -58,6 +59,7 @@ import Servant.API.ContentTypes (AcceptHeader (..),
import Servant.API.ResponseHeaders (GetHeaders, Headers, getHeaders,
getResponse)
import Servant.Server.Internal.Config
import Servant.Server.Internal.Router
import Servant.Server.Internal.RoutingApplication
import Servant.Server.Internal.ServantErr
@ -66,7 +68,7 @@ import Servant.Server.Internal.ServantErr
class HasServer layout where
type ServerT layout (m :: * -> *) :: *
route :: Proxy layout -> Delayed (Server layout) -> Router
route :: Proxy layout -> Config a -> Delayed (Server layout) -> Router
type Server layout = ServerT layout (ExceptT ServantErr IO)
@ -87,8 +89,8 @@ instance (HasServer a, HasServer b) => HasServer (a :<|> b) where
type ServerT (a :<|> b) m = ServerT a m :<|> ServerT b m
route Proxy server = choice (route pa ((\ (a :<|> _) -> a) <$> server))
(route pb ((\ (_ :<|> b) -> b) <$> server))
route Proxy cfg server = choice (route pa cfg ((\ (a :<|> _) -> a) <$> server))
(route pb cfg ((\ (_ :<|> b) -> b) <$> server))
where pa = Proxy :: Proxy a
pb = Proxy :: Proxy b
@ -118,9 +120,10 @@ instance (KnownSymbol capture, FromHttpApiData a, HasServer sublayout)
type ServerT (Capture capture a :> sublayout) m =
a -> ServerT sublayout m
route Proxy d =
route Proxy cfg d =
DynamicRouter $ \ first ->
route (Proxy :: Proxy sublayout)
cfg
(addCapture d $ case captured captureProxy first of
Nothing -> return $ Fail err404
Just v -> return $ Route v
@ -193,7 +196,7 @@ instance OVERLAPPABLE_
type ServerT (Verb method status ctypes a) m = m a
route Proxy = methodRouter method (Proxy :: Proxy ctypes) status
route Proxy _ = methodRouter method (Proxy :: Proxy ctypes) status
where method = reflectMethod (Proxy :: Proxy method)
status = toEnum . fromInteger $ natVal (Proxy :: Proxy status)
@ -204,7 +207,7 @@ instance OVERLAPPING_
type ServerT (Verb method status ctypes (Headers h a)) m = m (Headers h a)
route Proxy = methodRouterHeaders method (Proxy :: Proxy ctypes) status
route Proxy _ = methodRouterHeaders method (Proxy :: Proxy ctypes) status
where method = reflectMethod (Proxy :: Proxy method)
status = toEnum . fromInteger $ natVal (Proxy :: Proxy status)
@ -234,9 +237,9 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout)
type ServerT (Header sym a :> sublayout) m =
Maybe a -> ServerT sublayout m
route Proxy subserver = WithRequest $ \ request ->
route Proxy cfg subserver = WithRequest $ \ request ->
let mheader = parseHeaderMaybe =<< lookup str (requestHeaders request)
in route (Proxy :: Proxy sublayout) (passToServer subserver mheader)
in route (Proxy :: Proxy sublayout) cfg (passToServer subserver mheader)
where str = fromString $ symbolVal (Proxy :: Proxy sym)
-- | If you use @'QueryParam' "author" Text@ in one of the endpoints for your API,
@ -266,7 +269,7 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout)
type ServerT (QueryParam sym a :> sublayout) m =
Maybe a -> ServerT sublayout m
route Proxy subserver = WithRequest $ \ request ->
route Proxy cfg subserver = WithRequest $ \ request ->
let querytext = parseQueryText $ rawQueryString request
param =
case lookup paramname querytext of
@ -274,7 +277,7 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout)
Just Nothing -> Nothing -- param present with no value -> Nothing
Just (Just v) -> parseQueryParamMaybe v -- if present, we try to convert to
-- the right type
in route (Proxy :: Proxy sublayout) (passToServer subserver param)
in route (Proxy :: Proxy sublayout) cfg (passToServer subserver param)
where paramname = cs $ symbolVal (Proxy :: Proxy sym)
-- | If you use @'QueryParams' "authors" Text@ in one of the endpoints for your API,
@ -302,14 +305,14 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout)
type ServerT (QueryParams sym a :> sublayout) m =
[a] -> ServerT sublayout m
route Proxy subserver = WithRequest $ \ request ->
route Proxy cfg subserver = WithRequest $ \ request ->
let querytext = parseQueryText $ rawQueryString request
-- if sym is "foo", we look for query string parameters
-- named "foo" or "foo[]" and call parseQueryParam on the
-- corresponding values
parameters = filter looksLikeParam querytext
values = mapMaybe (convert . snd) parameters
in route (Proxy :: Proxy sublayout) (passToServer subserver values)
in route (Proxy :: Proxy sublayout) cfg (passToServer subserver values)
where paramname = cs $ symbolVal (Proxy :: Proxy sym)
looksLikeParam (name, _) = name == paramname || name == (paramname <> "[]")
convert Nothing = Nothing
@ -333,13 +336,13 @@ instance (KnownSymbol sym, HasServer sublayout)
type ServerT (QueryFlag sym :> sublayout) m =
Bool -> ServerT sublayout m
route Proxy subserver = WithRequest $ \ request ->
route Proxy cfg subserver = WithRequest $ \ request ->
let querytext = parseQueryText $ rawQueryString request
param = case lookup paramname querytext of
Just Nothing -> True -- param is there, with no value
Just (Just v) -> examine v -- param with a value
Nothing -> False -- param not in the query string
in route (Proxy :: Proxy sublayout) (passToServer subserver param)
in route (Proxy :: Proxy sublayout) cfg (passToServer subserver param)
where paramname = cs $ symbolVal (Proxy :: Proxy sym)
examine v | v == "true" || v == "1" || v == "" = True
| otherwise = False
@ -356,7 +359,7 @@ instance HasServer Raw where
type ServerT Raw m = Application
route Proxy rawApplication = LeafRouter $ \ request respond -> do
route Proxy _ rawApplication = LeafRouter $ \ request respond -> do
r <- runDelayed rawApplication
case r of
Route app -> app request (respond . Route)
@ -390,8 +393,8 @@ instance ( AllCTUnrender list a, HasServer sublayout
type ServerT (ReqBody list a :> sublayout) m =
a -> ServerT sublayout m
route Proxy subserver = WithRequest $ \ request ->
route (Proxy :: Proxy sublayout) (addBodyCheck subserver (bodyCheck request))
route Proxy cfg subserver = WithRequest $ \ request ->
route (Proxy :: Proxy sublayout) cfg (addBodyCheck subserver (bodyCheck request))
where
bodyCheck request = do
-- See HTTP RFC 2616, section 7.2.1
@ -413,36 +416,36 @@ instance (KnownSymbol path, HasServer sublayout) => HasServer (path :> sublayout
type ServerT (path :> sublayout) m = ServerT sublayout m
route Proxy subserver = StaticRouter $
route Proxy cfg subserver = StaticRouter $
M.singleton (cs (symbolVal proxyPath))
(route (Proxy :: Proxy sublayout) subserver)
(route (Proxy :: Proxy sublayout) cfg subserver)
where proxyPath = Proxy :: Proxy path
instance HasServer api => HasServer (RemoteHost :> api) where
type ServerT (RemoteHost :> api) m = SockAddr -> ServerT api m
route Proxy subserver = WithRequest $ \req ->
route (Proxy :: Proxy api) (passToServer subserver $ remoteHost req)
route Proxy cfg subserver = WithRequest $ \req ->
route (Proxy :: Proxy api) cfg (passToServer subserver $ remoteHost req)
instance HasServer api => HasServer (IsSecure :> api) where
type ServerT (IsSecure :> api) m = IsSecure -> ServerT api m
route Proxy subserver = WithRequest $ \req ->
route (Proxy :: Proxy api) (passToServer subserver $ secure req)
route Proxy cfg subserver = WithRequest $ \req ->
route (Proxy :: Proxy api) cfg (passToServer subserver $ secure req)
where secure req = if isSecure req then Secure else NotSecure
instance HasServer api => HasServer (Vault :> api) where
type ServerT (Vault :> api) m = Vault -> ServerT api m
route Proxy subserver = WithRequest $ \req ->
route (Proxy :: Proxy api) (passToServer subserver $ vault req)
route Proxy cfg subserver = WithRequest $ \req ->
route (Proxy :: Proxy api) cfg (passToServer subserver $ vault req)
instance HasServer api => HasServer (HttpVersion :> api) where
type ServerT (HttpVersion :> api) m = HttpVersion -> ServerT api m
route Proxy subserver = WithRequest $ \req ->
route (Proxy :: Proxy api) (passToServer subserver $ httpVersion req)
route Proxy cfg subserver = WithRequest $ \req ->
route (Proxy :: Proxy api) cfg (passToServer subserver $ httpVersion req)
pathIsEmpty :: Request -> Bool
pathIsEmpty = go . pathInfo

62
servant-server/src/Servant/Server/Internal/Config.hs Normal file
View file

@ -0,0 +1,62 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
#if !MIN_VERSION_base(4,8,0)
{-# LANGUAGE OverlappingInstances #-}
#endif
module Servant.Server.Internal.Config where
import GHC.Generics (Generic)
import Data.Typeable (Typeable)
-- | A single entry in the configuration. The first parameter is phantom, and
-- is used to lookup a @ConfigEntry@ in a @Config@.
newtype ConfigEntry tag a = ConfigEntry { unConfigEntry :: a }
deriving ( Eq, Show, Read, Enum, Integral, Fractional, Generic, Typeable
, Num, Ord, Real, Functor, Foldable, Traversable)
instance Applicative (ConfigEntry tag) where
pure = ConfigEntry
ConfigEntry f <*> ConfigEntry a = ConfigEntry $ f a
instance Monad (ConfigEntry tag) where
return = ConfigEntry
ConfigEntry a >>= f = f a
-- | The entire configuration.
data Config a where
EmptyConfig :: Config '[]
ConsConfig :: x -> Config xs -> Config (x ': xs)
(.:) :: x -> Config xs -> Config (ConfigEntry tag x ': xs)
e .: cfg = ConsConfig (ConfigEntry e) cfg
infixr 4 .:
class HasConfigEntry (cfg :: [*]) a val | cfg a -> val where
getConfigEntry :: proxy a -> Config cfg -> val
instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPABLE #-}
#endif
HasConfigEntry xs tag val => HasConfigEntry (notIt ': xs) tag val where
getConfigEntry p (ConsConfig _ xs) = getConfigEntry p xs
instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPABLE #-}
#endif
HasConfigEntry (ConfigEntry tag val ': xs) tag val where
getConfigEntry _ (ConsConfig x _) = unConfigEntry x

8
servant-server/test/Servant/Server/ErrorSpec.hs
View file

@ -42,7 +42,7 @@ errorOrderServer = \_ _ -> throwE err402
errorOrderSpec :: Spec
errorOrderSpec = describe "HTTP error order"
$ with (return $ serve errorOrderApi errorOrderServer) $ do
$ with (return $ serve errorOrderApi EmptyConfig errorOrderServer) $ do
let badContentType = (hContentType, "text/plain")
badAccept = (hAccept, "text/plain")
badMethod = methodGet
@ -89,7 +89,7 @@ prioErrorsApi = Proxy
prioErrorsSpec :: Spec
prioErrorsSpec = describe "PrioErrors" $ do
let server = return
with (return $ serve prioErrorsApi server) $ do
with (return $ serve prioErrorsApi EmptyConfig server) $ do
let check (mdescr, method) path (cdescr, ctype, body) resp =
it fulldescr $
Test.Hspec.Wai.request method path [(hContentType, ctype)] body
@ -154,7 +154,7 @@ errorRetryServer
errorRetrySpec :: Spec
errorRetrySpec = describe "Handler search"
$ with (return $ serve errorRetryApi errorRetryServer) $ do
$ with (return $ serve errorRetryApi EmptyConfig errorRetryServer) $ do
let jsonCT = (hContentType, "application/json")
jsonAccept = (hAccept, "application/json")
@ -194,7 +194,7 @@ errorChoiceServer = return 0
errorChoiceSpec :: Spec
errorChoiceSpec = describe "Multiple handlers return errors"
$ with (return $ serve errorChoiceApi errorChoiceServer) $ do
$ with (return $ serve errorChoiceApi EmptyConfig errorChoiceServer) $ do
it "should respond with 404 if no path matches" $ do
request methodGet "" [] "" `shouldRespondWith` 404

4
servant-server/test/Servant/Server/Internal/EnterSpec.hs
View file

@ -48,12 +48,12 @@ combinedReaderServer = enter fReader combinedReaderServer'
enterSpec :: Spec
enterSpec = describe "Enter" $ do
with (return (serve readerAPI readerServer)) $ do
with (return (serve readerAPI EmptyConfig readerServer)) $ do
it "allows running arbitrary monads" $ do
get "int" `shouldRespondWith` "1797"
post "string" "3" `shouldRespondWith` "\"hi\""{ matchStatus = 200 }
with (return (serve combinedAPI combinedReaderServer)) $ do
with (return (serve combinedAPI EmptyConfig combinedReaderServer)) $ do
it "allows combnation of enters" $ do
get "bool" `shouldRespondWith` "true"

66
servant-server/test/Servant/ServerSpec.hs
View file

@ -23,14 +23,15 @@ import Data.String (fromString)
import Data.String.Conversions (cs)
import qualified Data.Text as T
import GHC.Generics (Generic)
import Network.HTTP.Types (hAccept, hContentType,
methodDelete, methodGet, methodHead,
methodPatch, methodPost, methodPut,
ok200, parseQuery, Status(..))
import Network.HTTP.Types (Status (..), hAccept, hContentType,
methodDelete, methodGet,
methodHead, methodPatch,
methodPost, methodPut, ok200,
parseQuery)
import Network.Wai (Application, Request, pathInfo,
queryString, rawQueryString,
responseLBS, responseBuilder)
import Network.Wai.Internal (Response(ResponseBuilder))
responseBuilder, responseLBS)
import Network.Wai.Internal (Response (ResponseBuilder))
import Network.Wai.Test (defaultRequest, request,
runSession, simpleBody)
import Servant.API ((:<|>) (..), (:>), Capture, Delete,
@ -40,15 +41,21 @@ import Servant.API ((:<|>) (..), (:>), Capture, Delete,
QueryFlag, QueryParam, QueryParams,
Raw, RemoteHost, ReqBody, GetNoContent,
PostNoContent, addHeader, NoContent(..))
import Servant.Server (Server, serve, ServantErr(..), err404)
-- import Servant.Server (Server, serve, ServantErr(..), err404)
import Test.Hspec (Spec, describe, it, shouldBe)
import Test.Hspec.Wai (get, liftIO, matchHeaders,
matchStatus, post, request,
shouldRespondWith, with, (<:>))
import Servant.Server.Internal.RoutingApplication (toApplication, RouteResult(..))
import Servant.Server.Internal.Router
(tweakResponse, runRouter,
Router, Router'(LeafRouter))
import Servant.Server (Config(EmptyConfig),
ServantErr (..),
Server, err404,
serve)
import Servant.Server.Internal.Router (Router, Router' (LeafRouter),
runRouter,
tweakResponse)
import Servant.Server.Internal.RoutingApplication (RouteResult (..),
toApplication)
-- * test data types
@ -112,7 +119,7 @@ captureServer legs = case legs of
captureSpec :: Spec
captureSpec = do
describe "Servant.API.Capture" $ do
with (return (serve captureApi captureServer)) $ do
with (return (serve captureApi EmptyConfig captureServer)) $ do
it "can capture parts of the 'pathInfo'" $ do
response <- get "/2"
@ -123,6 +130,7 @@ captureSpec = do
with (return (serve
(Proxy :: Proxy (Capture "captured" String :> Raw))
EmptyConfig
(\ "captured" request_ respond ->
respond $ responseLBS ok200 [] (cs $ show $ pathInfo request_)))) $ do
it "strips the captured path snippet from pathInfo" $ do
@ -145,7 +153,7 @@ getSpec = do
:<|> return (addHeader 5 NoContent)
:<|> return NoContent
with (return $ serve getApi server) $ do
with (return $ serve getApi EmptyConfig server) $ do
it "allows to GET a Person" $ do
response <- get "/"
@ -171,7 +179,7 @@ headSpec = do
:<|> return NoContent
:<|> return (addHeader 5 NoContent)
:<|> return NoContent
with (return $ serve getApi server) $ do
with (return $ serve getApi EmptyConfig server) $ do
it "allows to GET a Person" $ do
response <- Test.Hspec.Wai.request methodHead "/" [] ""
@ -214,7 +222,7 @@ queryParamSpec :: Spec
queryParamSpec = do
describe "Servant.API.QueryParam" $ do
it "allows to retrieve simple GET parameters" $
(flip runSession) (serve queryParamApi qpServer) $ do
(flip runSession) (serve queryParamApi EmptyConfig qpServer) $ do
let params1 = "?name=bob"
response1 <- Network.Wai.Test.request defaultRequest{
rawQueryString = params1,
@ -226,7 +234,7 @@ queryParamSpec = do
}
it "allows to retrieve lists in GET parameters" $
(flip runSession) (serve queryParamApi qpServer) $ do
(flip runSession) (serve queryParamApi EmptyConfig qpServer) $ do
let params2 = "?names[]=bob&names[]=john"
response2 <- Network.Wai.Test.request defaultRequest{
rawQueryString = params2,
@ -240,7 +248,7 @@ queryParamSpec = do
it "allows to retrieve value-less GET parameters" $
(flip runSession) (serve queryParamApi qpServer) $ do
(flip runSession) (serve queryParamApi EmptyConfig qpServer) $ do
let params3 = "?capitalize"
response3 <- Network.Wai.Test.request defaultRequest{
rawQueryString = params3,
@ -286,7 +294,7 @@ postSpec :: Spec
postSpec = do
describe "Servant.API.Post and .ReqBody" $ do
let server = return . age :<|> return . age :<|> return ()
with (return $ serve postApi server) $ do
with (return $ serve postApi EmptyConfig server) $ do
let post' x = Test.Hspec.Wai.request methodPost x [(hContentType
, "application/json;charset=utf-8")]
@ -325,7 +333,7 @@ putSpec :: Spec
putSpec = do
describe "Servant.API.Put and .ReqBody" $ do
let server = return . age :<|> return . age :<|> return ()
with (return $ serve putApi server) $ do
with (return $ serve putApi EmptyConfig server) $ do
let put' x = Test.Hspec.Wai.request methodPut x [(hContentType
, "application/json;charset=utf-8")]
@ -364,7 +372,7 @@ patchSpec :: Spec
patchSpec = do
describe "Servant.API.Patch and .ReqBody" $ do
let server = return . age :<|> return . age :<|> return ()
with (return $ serve patchApi server) $ do
with (return $ serve patchApi EmptyConfig server) $ do
let patch' x = Test.Hspec.Wai.request methodPatch x [(hContentType
, "application/json;charset=utf-8")]
@ -406,14 +414,14 @@ headerSpec = describe "Servant.API.Header" $ do
expectsString (Just x) = when (x /= "more from you") $ error "Expected more from you"
expectsString Nothing = error "Expected a string"
with (return (serve headerApi expectsInt)) $ do
let delete' x = Test.Hspec.Wai.request methodDelete x [("MyHeader", "5")]
with (return (serve headerApi EmptyConfig expectsInt)) $ do
let delete' x = Test.Hspec.Wai.request methodDelete x [("MyHeader" ,"5")]
it "passes the header to the handler (Int)" $
delete' "/" "" `shouldRespondWith` 200
with (return (serve headerApi expectsString)) $ do
let delete' x = Test.Hspec.Wai.request methodDelete x [("MyHeader", "more from you")]
with (return (serve headerApi EmptyConfig expectsString)) $ do
let delete' x = Test.Hspec.Wai.request methodDelete x [("MyHeader" ,"more from you")]
it "passes the header to the handler (String)" $
delete' "/" "" `shouldRespondWith` 200
@ -429,7 +437,7 @@ rawSpec :: Spec
rawSpec = do
describe "Servant.API.Raw" $ do
it "runs applications" $ do
(flip runSession) (serve rawApi (rawApplication (const (42 :: Integer)))) $ do
(flip runSession) (serve rawApi EmptyConfig (rawApplication (const (42 :: Integer)))) $ do
response <- Network.Wai.Test.request defaultRequest{
pathInfo = ["foo"]
}
@ -437,7 +445,7 @@ rawSpec = do
simpleBody response `shouldBe` "42"
it "gets the pathInfo modified" $ do
(flip runSession) (serve rawApi (rawApplication pathInfo)) $ do
(flip runSession) (serve rawApi EmptyConfig (rawApplication pathInfo)) $ do
response <- Network.Wai.Test.request defaultRequest{
pathInfo = ["foo", "bar"]
}
@ -467,7 +475,7 @@ unionServer =
unionSpec :: Spec
unionSpec = do
describe "Servant.API.Alternative" $ do
with (return $ serve unionApi unionServer) $ do
with (return $ serve unionApi EmptyConfig unionServer) $ do
it "unions endpoints" $ do
response <- get "/foo"
@ -499,7 +507,7 @@ responseHeadersServer = let h = return $ addHeader 5 $ addHeader "kilroy" "hi"
responseHeadersSpec :: Spec
responseHeadersSpec = describe "ResponseHeaders" $ do
with (return $ serve (Proxy :: Proxy ResponseHeadersApi) responseHeadersServer) $ do
with (return $ serve (Proxy :: Proxy ResponseHeadersApi) EmptyConfig responseHeadersServer) $ do
let methods = [(methodGet, 200), (methodPost, 200), (methodPut, 200), (methodPatch, 200)]
@ -558,7 +566,7 @@ miscServ = versionHandler
hostHandler = return . show
miscReqCombinatorsSpec :: Spec
miscReqCombinatorsSpec = with (return $ serve miscApi miscServ) $
miscReqCombinatorsSpec = with (return $ serve miscApi EmptyConfig miscServ) $
describe "Misc. combinators for request inspection" $ do
it "Successfully gets the HTTP version specified in the request" $
go "/version" "\"HTTP/1.0\""

4
servant-server/test/Servant/Utils/StaticFilesSpec.hs
View file

@ -16,7 +16,7 @@ import Test.Hspec (Spec, around_, describe, it)
import Test.Hspec.Wai (get, shouldRespondWith, with)
import Servant.API ((:<|>) ((:<|>)), Capture, Get, Raw, (:>), JSON)
import Servant.Server (Server, serve)
import Servant.Server (Server, serve, Config(EmptyConfig))
import Servant.ServerSpec (Person (Person))
import Servant.Utils.StaticFiles (serveDirectory)
@ -29,7 +29,7 @@ api :: Proxy Api
api = Proxy
app :: Application
app = serve api server
app = serve api EmptyConfig server
server :: Server Api
server =