f137972 · servant · git.iko.soy

git.iko.soy/servant

Add 'serveWithConfig'.

And keep the old signature for 'serve'

commitf137972e5d397fe20b57b73a4fb67e8ff9101422 authorJulian K. Arni <jkarni@gmail.com> dateThu 18 Feb 2016, 16:36 (11 years ago) parent1e5bdd6

24 files changed+64−70

compare with master

unifiedsplit

servant-client/test/Servant/ClientSpec.hs+3−3

@@ -115,7 +115,7 @@ api :: Proxy Api

115115api = Proxy

116116

117117server :: Application

118−server = serve api EmptyConfig (

118+server = serve api (

119119 return alice

120120 :<|> return NoContent

121121 :<|> (\ name -> return $ Person name 0)

@@ -142,7 +142,7 @@ failApi :: Proxy FailApi

142142failApi = Proxy

143143

144144failServer :: Application

145−failServer = serve failApi EmptyConfig (

145+failServer = serve failApi (

146146 (\ _request respond -> respond $ responseLBS ok200 [] "")

147147 :<|> (\ _capture _request respond -> respond $ responseLBS ok200 [("content-type", "application/json")] "")

148148 :<|> (\_request respond -> respond $ responseLBS ok200 [("content-type", "fooooo")] "")

@@ -232,7 +232,7 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do

232232

233233wrappedApiSpec :: Spec

234234wrappedApiSpec = describe "error status codes" $ do

235− let serveW api = serve api EmptyConfig $ throwE $ ServantErr 500 "error message" "" []

235+ let serveW api = serve api $ throwE $ ServantErr 500 "error message" "" []

236236 context "are correctly handled by the client" $

237237 let test :: (WrappedApi, String) -> Spec

238238 test (WrappedApi api, desc) =

servant-examples/auth-combinator/auth-combinator.hs+1−1

@@ -82,7 +82,7 @@ main :: IO ()

8282main = do

8383 dbConnection <- initDB

8484 let config = dbConnection :. EmptyConfig

85− run 8080 (serve api config server)

85+ run 8080 (serveWithConfig api config server)

8686

8787{- Sample session:

8888$ curl http://localhost:8080/

servant-examples/socket-io-chat/socket-io-chat.hs+1−1

@@ -38,7 +38,7 @@ server sHandler = socketIOHandler

3838

3939

4040app :: WaiMonad () -> Application

41−app sHandler = serve api EmptyConfig $ server sHandler

41+app sHandler = serve api $ server sHandler

4242

4343port :: Int

4444port = 3001

servant-examples/tutorial/T1.hs+1−1

@@ -42,4 +42,4 @@ server :: Server UserAPI

4242server = return users

4343

4444app :: Application

45−app = serve userAPI EmptyConfig server

45+app = serve userAPI server

servant-examples/tutorial/T10.hs+1−1

@@ -68,4 +68,4 @@ server = T3.server :<|> serveDocs

6868 plain = ("Content-Type", "text/plain")

6969

7070app :: Application

71−app = serve api EmptyConfig server

71+app = serve api server

servant-examples/tutorial/T2.hs+1−1

@@ -49,4 +49,4 @@ server = return users

4949 :<|> return isaac

5050

5151app :: Application

52−app = serve userAPI EmptyConfig server

52+app = serve userAPI server

servant-examples/tutorial/T3.hs+1−1

@@ -81,4 +81,4 @@ server = position

8181 marketing clientinfo = return (emailForClient clientinfo)

8282

8383app :: Application

84−app = serve api EmptyConfig server

84+app = serve api server

servant-examples/tutorial/T4.hs+1−1

@@ -60,4 +60,4 @@ server :: Server PersonAPI

6060server = return persons

6161

6262app :: Application

63−app = serve personAPI EmptyConfig server

63+app = serve personAPI server

servant-examples/tutorial/T5.hs+1−1

@@ -34,4 +34,4 @@ server = do

3434 where custom404Err = err404 { errBody = "myfile.txt just isn't there, please leave this server alone." }

3535

3636app :: Application

37−app = serve ioAPI EmptyConfig server

37+app = serve ioAPI server

servant-examples/tutorial/T6.hs+1−1

@@ -15,4 +15,4 @@ server :: Server API

1515server = serveDirectory "tutorial"

1616

1717app :: Application

18−app = serve api EmptyConfig server

18+app = serve api server

servant-examples/tutorial/T7.hs+1−1

@@ -30,4 +30,4 @@ readerServer = enter readerToEither readerServerT

3030 readerToEither = Nat $ \r -> return (runReader r "hi")

3131

3232app :: Application

33−app = serve readerAPI EmptyConfig readerServer

33+app = serve readerAPI readerServer

servant-examples/tutorial/T9.hs+1−1

@@ -102,4 +102,4 @@ writeJSFiles = do

102102 TIO.writeFile "tutorial/t9/jq.js" jq

103103

104104app :: Application

105−app = serve api' EmptyConfig server'

105+app = serve api' server'

servant-examples/wai-middleware/wai-middleware.hs+1−1

@@ -45,7 +45,7 @@ server = return products

4545-- so applying a middleware is really as simple as

4646-- applying a function to the result of 'serve'

4747app :: Application

48−app = logStdout (serve simpleAPI EmptyConfig server)

48+app = logStdout (serve simpleAPI server)

4949

5050main :: IO ()

5151main = run 8080 app

servant-mock/example/main.hs+1−1

@@ -20,4 +20,4 @@ api :: Proxy API

2020api = Proxy

2121

2222main :: IO ()

23−main = run 8080 (serve api EmptyConfig $ mock api Proxy)

23+main = run 8080 (serve api $ mock api Proxy)

servant-mock/src/Servant/Mock.hs+8−9

@@ -1,12 +1,12 @@

1−{-# LANGUAGE CPP #-}

2−{-# LANGUAGE DataKinds #-}

3−{-# LANGUAGE FlexibleContexts #-}

4−{-# LANGUAGE FlexibleInstances #-}

1+{-# LANGUAGE CPP #-}

2+{-# LANGUAGE DataKinds #-}

3+{-# LANGUAGE FlexibleContexts #-}

4+{-# LANGUAGE FlexibleInstances #-}

55{-# LANGUAGE MultiParamTypeClasses #-}

6−{-# LANGUAGE PolyKinds #-}

7−{-# LANGUAGE ScopedTypeVariables #-}

8−{-# LANGUAGE TypeFamilies #-}

9−{-# LANGUAGE TypeOperators #-}

6+{-# LANGUAGE PolyKinds #-}

7+{-# LANGUAGE ScopedTypeVariables #-}

8+{-# LANGUAGE TypeFamilies #-}

9+{-# LANGUAGE TypeOperators #-}

1010{-# OPTIONS_GHC -fno-warn-orphans #-}

1111

1212#include "overlapping-compat.h"

@@ -67,7 +67,6 @@ import Network.HTTP.Types.Status

6767import Network.Wai

6868import Servant

6969import Servant.API.ContentTypes

70−import Servant.Server.Internal.Config

7170import Test.QuickCheck.Arbitrary (Arbitrary (..), vector)

7271import Test.QuickCheck.Gen (Gen, generate)

7372

servant-mock/test/Servant/MockSpec.hs+2−2

@@ -52,7 +52,7 @@ spec = do

5252 context "Get" $ do

5353 let api :: Proxy (Get '[JSON] Body)

5454 api = Proxy

55− app = serve api EmptyConfig (mock api Proxy)

55+ app = serve api (mock api Proxy)

5656 with (return app) $ do

5757 it "serves arbitrary response bodies" $ do

5858 get "/" `shouldRespondWith` 200{

@@ -65,7 +65,7 @@ spec = do

6565 withoutHeader :: Proxy (Get '[JSON] (Headers '[] Body))

6666 withoutHeader = Proxy

6767 toApp :: (HasMock api '[]) => Proxy api -> IO Application

68− toApp api = return $ serve api EmptyConfig (mock api (Proxy :: Proxy '[]))

68+ toApp api = return $ serve api (mock api (Proxy :: Proxy '[]))

6969 with (toApp withHeader) $ do

7070 it "serves arbitrary response bodies" $ do

7171 get "/" `shouldRespondWith` 200{

servant-server/example/greet.hs+1−1

@@ -59,7 +59,7 @@ server = helloH :<|> postGreetH :<|> deleteGreetH

5959-- Turn the server into a WAI app. 'serve' is provided by servant,

6060-- more precisely by the Servant.Server module.

6161test :: Application

62−test = serve testApi EmptyConfig server

62+test = serve testApi server

6363

6464-- Run the server.

6565--

servant-server/src/Servant/Server.hs+8−6

@@ -1,4 +1,5 @@

11{-# LANGUAGE ConstraintKinds #-}

2+{-# LANGUAGE DataKinds #-}

23{-# LANGUAGE FlexibleContexts #-}

34{-# LANGUAGE OverloadedStrings #-}

45{-# LANGUAGE TypeFamilies #-}

@@ -8,6 +9,7 @@

89module Servant.Server

910 ( -- * Run a wai application from an API

1011 serve

12+ , serveWithConfig

1113

1214 , -- * Construct a wai Application from an API

1315 toApplication

@@ -104,18 +106,18 @@ import Servant.Server.Internal.Enter

104106-- > myApi :: Proxy MyApi

105107-- > myApi = Proxy

106108-- >

107−-- > config :: Config '[]

108−-- > config = EmptyConfig

109−-- >

110109-- > app :: Application

111−-- > app = serve myApi config server

110+-- > app = serve myApi server

112111-- >

113112-- > main :: IO ()

114113-- > main = Network.Wai.Handler.Warp.run 8080 app

115114--

116−serve :: (HasServer layout config)

115+serve :: (HasServer layout '[]) => Proxy layout -> Server layout -> Application

116+serve p = serveWithConfig p EmptyConfig

117+

118+serveWithConfig :: (HasServer layout config)

117119 => Proxy layout -> Config config -> Server layout -> Application

118−serve p config server = toApplication (runRouter (route p config d))

120+serveWithConfig p config server = toApplication (runRouter (route p config d))

119121 where

120122 d = Delayed r r r (\ _ _ -> Route server)

121123 r = return (Route ())

servant-server/src/Servant/Server/Internal/RoutingApplication.hs+1−7

@@ -11,14 +11,8 @@ module Servant.Server.Internal.RoutingApplication where

1111import Control.Applicative ((<$>))

1212#endif

1313import Control.Monad.Trans.Except (ExceptT, runExceptT)

14−import qualified Data.ByteString as B

15−import qualified Data.ByteString.Lazy as BL

16−import Data.IORef (newIORef, readIORef,

17− writeIORef)

1814import Network.Wai (Application, Request,

19− Response, ResponseReceived,

20− requestBody,

21− strictRequestBody)

15+ Response, ResponseReceived)

2216import Servant.Server.Internal.ServantErr

2317

2418type RoutingApplication =

servant-server/test/Servant/Server/ErrorSpec.hs+4−4

@@ -42,7 +42,7 @@ errorOrderServer = \_ _ -> throwE err402

4242

4343errorOrderSpec :: Spec

4444errorOrderSpec = describe "HTTP error order"

45− $ with (return $ serve errorOrderApi EmptyConfig errorOrderServer) $ do

45+ $ with (return $ serve errorOrderApi errorOrderServer) $ do

4646 let badContentType = (hContentType, "text/plain")

4747 badAccept = (hAccept, "text/plain")

4848 badMethod = methodGet

@@ -89,7 +89,7 @@ prioErrorsApi = Proxy

8989prioErrorsSpec :: Spec

9090prioErrorsSpec = describe "PrioErrors" $ do

9191 let server = return

92− with (return $ serve prioErrorsApi EmptyConfig server) $ do

92+ with (return $ serve prioErrorsApi server) $ do

9393 let check (mdescr, method) path (cdescr, ctype, body) resp =

9494 it fulldescr $

9595 Test.Hspec.Wai.request method path [(hContentType, ctype)] body

@@ -154,7 +154,7 @@ errorRetryServer

154154

155155errorRetrySpec :: Spec

156156errorRetrySpec = describe "Handler search"

157− $ with (return $ serve errorRetryApi EmptyConfig errorRetryServer) $ do

157+ $ with (return $ serve errorRetryApi errorRetryServer) $ do

158158

159159 let jsonCT = (hContentType, "application/json")

160160 jsonAccept = (hAccept, "application/json")

@@ -198,7 +198,7 @@ errorChoiceServer = return 0

198198

199199errorChoiceSpec :: Spec

200200errorChoiceSpec = describe "Multiple handlers return errors"

201− $ with (return $ serve errorChoiceApi EmptyConfig errorChoiceServer) $ do

201+ $ with (return $ serve errorChoiceApi errorChoiceServer) $ do

202202

203203 it "should respond with 404 if no path matches" $ do

204204 request methodGet "" [] "" `shouldRespondWith` 404

servant-server/test/Servant/Server/Internal/EnterSpec.hs+2−2

@@ -48,12 +48,12 @@ combinedReaderServer = enter fReader combinedReaderServer'

4848

4949enterSpec :: Spec

5050enterSpec = describe "Enter" $ do

51− with (return (serve readerAPI EmptyConfig readerServer)) $ do

51+ with (return (serve readerAPI readerServer)) $ do

5252

5353 it "allows running arbitrary monads" $ do

5454 get "int" `shouldRespondWith` "1797"

5555 post "string" "3" `shouldRespondWith` "\"hi\""{ matchStatus = 200 }

5656

57− with (return (serve combinedAPI EmptyConfig combinedReaderServer)) $ do

57+ with (return (serve combinedAPI combinedReaderServer)) $ do

5858 it "allows combnation of enters" $ do

5959 get "bool" `shouldRespondWith` "true"

servant-server/test/Servant/Server/UsingConfigSpec.hs+5−5

@@ -30,7 +30,7 @@ testServer s = return s

3030

3131oneEntryApp :: Application

3232oneEntryApp =

33− serve (Proxy :: Proxy OneEntryAPI) config testServer

33+ serveWithConfig (Proxy :: Proxy OneEntryAPI) config testServer

3434 where

3535 config :: Config '[String]

3636 config = "configEntry" :. EmptyConfig

@@ -40,7 +40,7 @@ type OneEntryTwiceAPI =

4040 "bar" :> ExtractFromConfig :> Get '[JSON] String

4141

4242oneEntryTwiceApp :: Application

43−oneEntryTwiceApp = serve (Proxy :: Proxy OneEntryTwiceAPI) config $

43+oneEntryTwiceApp = serveWithConfig (Proxy :: Proxy OneEntryTwiceAPI) config $

4444 testServer :<|>

4545 testServer

4646 where

@@ -68,7 +68,7 @@ type InjectAPI =

6868 Get '[JSON] String

6969

7070injectApp :: Application

71−injectApp = serve (Proxy :: Proxy InjectAPI) config $

71+injectApp = serveWithConfig (Proxy :: Proxy InjectAPI) config $

7272 (\ s -> return s) :<|>

7373 (\ s -> return ("tagged: " ++ s))

7474 where

@@ -90,7 +90,7 @@ type WithBirdfaceAPI =

9090 "bar" :> ExtractFromConfig :> Get '[JSON] String

9191

9292withBirdfaceApp :: Application

93−withBirdfaceApp = serve (Proxy :: Proxy WithBirdfaceAPI) config $

93+withBirdfaceApp = serveWithConfig (Proxy :: Proxy WithBirdfaceAPI) config $

9494 testServer :<|>

9595 testServer

9696 where

@@ -112,7 +112,7 @@ type NamedConfigAPI =

112112 ExtractFromConfig :> Get '[JSON] String)

113113

114114namedConfigApp :: Application

115−namedConfigApp = serve (Proxy :: Proxy NamedConfigAPI) config return

115+namedConfigApp = serveWithConfig (Proxy :: Proxy NamedConfigAPI) config return

116116 where

117117 config :: Config '[NamedConfig "sub" '[String]]

118118 config = NamedConfig ("descend" :. EmptyConfig) :. EmptyConfig

servant-server/test/Servant/ServerSpec.hs+15−16

@@ -49,7 +49,7 @@ import Servant.API ((:<|>) (..), (:>), Capture, Delete,

4949 StdMethod (..), Verb, addHeader)

5050import Servant.API.Internal.Test.ComprehensiveAPI

5151import Servant.Server (ServantErr (..), Server, err404,

52− serve, Config(EmptyConfig))

52+ serve, serveWithConfig, Config(EmptyConfig))

5353import Test.Hspec (Spec, context, describe, it,

5454 shouldBe, shouldContain)

5555import Test.Hspec.Wai (get, liftIO, matchHeaders,

@@ -67,7 +67,7 @@ import Servant.Server.Internal.Config

6767-- * comprehensive api test

6868

6969-- This declaration simply checks that all instances are in place.

70−_ = serve comprehensiveAPI comprehensiveApiConfig

70+_ = serveWithConfig comprehensiveAPI comprehensiveApiConfig

7171

7272comprehensiveApiConfig :: Config '[NamedConfig "foo" '[]]

7373comprehensiveApiConfig = NamedConfig EmptyConfig :. EmptyConfig

@@ -112,7 +112,7 @@ verbSpec = describe "Servant.API.Verb" $ do

112112 wrongMethod m = if m == methodPatch then methodPost else methodPatch

113113 test desc api method (status :: Int) = context desc $

114114

115− with (return $ serve api EmptyConfig server) $ do

115+ with (return $ serve api server) $ do

116116

117117 -- HEAD and 214/215 need not return bodies

118118 unless (status `elem` [214, 215] || method == methodHead) $

@@ -187,7 +187,7 @@ captureServer legs = case legs of

187187captureSpec :: Spec

188188captureSpec = do

189189 describe "Servant.API.Capture" $ do

190− with (return (serve captureApi EmptyConfig captureServer)) $ do

190+ with (return (serve captureApi captureServer)) $ do

191191

192192 it "can capture parts of the 'pathInfo'" $ do

193193 response <- get "/2"

@@ -198,7 +198,6 @@ captureSpec = do

198198

199199 with (return (serve

200200 (Proxy :: Proxy (Capture "captured" String :> Raw))

201− EmptyConfig

202201 (\ "captured" request_ respond ->

203202 respond $ responseLBS ok200 [] (cs $ show $ pathInfo request_)))) $ do

204203 it "strips the captured path snippet from pathInfo" $ do

@@ -232,7 +231,7 @@ queryParamSpec :: Spec

232231queryParamSpec = do

233232 describe "Servant.API.QueryParam" $ do

234233 it "allows retrieving simple GET parameters" $

235− (flip runSession) (serve queryParamApi EmptyConfig qpServer) $ do

234+ (flip runSession) (serve queryParamApi qpServer) $ do

236235 let params1 = "?name=bob"

237236 response1 <- Network.Wai.Test.request defaultRequest{

238237 rawQueryString = params1,

@@ -244,7 +243,7 @@ queryParamSpec = do

244243 }

245244

246245 it "allows retrieving lists in GET parameters" $

247− (flip runSession) (serve queryParamApi EmptyConfig qpServer) $ do

246+ (flip runSession) (serve queryParamApi qpServer) $ do

248247 let params2 = "?names[]=bob&names[]=john"

249248 response2 <- Network.Wai.Test.request defaultRequest{

250249 rawQueryString = params2,

@@ -258,7 +257,7 @@ queryParamSpec = do

258257

259258

260259 it "allows retrieving value-less GET parameters" $

261− (flip runSession) (serve queryParamApi EmptyConfig qpServer) $ do

260+ (flip runSession) (serve queryParamApi qpServer) $ do

262261 let params3 = "?capitalize"

263262 response3 <- Network.Wai.Test.request defaultRequest{

264263 rawQueryString = params3,

@@ -310,7 +309,7 @@ reqBodySpec = describe "Servant.API.ReqBody" $ do

310309 mkReq method x = Test.Hspec.Wai.request method x

311310 [(hContentType, "application/json;charset=utf-8")]

312311

313− with (return $ serve reqBodyApi EmptyConfig server) $ do

312+ with (return $ serve reqBodyApi server) $ do

314313

315314 it "passes the argument to the handler" $ do

316315 response <- mkReq methodPost "" (encode alice)

@@ -343,13 +342,13 @@ headerSpec = describe "Servant.API.Header" $ do

343342 expectsString (Just x) = when (x /= "more from you") $ error "Expected more from you"

344343 expectsString Nothing = error "Expected a string"

345344

346− with (return (serve headerApi EmptyConfig expectsInt)) $ do

345+ with (return (serve headerApi expectsInt)) $ do

347346 let delete' x = Test.Hspec.Wai.request methodDelete x [("MyHeader", "5")]

348347

349348 it "passes the header to the handler (Int)" $

350349 delete' "/" "" `shouldRespondWith` 200

351350

352− with (return (serve headerApi EmptyConfig expectsString)) $ do

351+ with (return (serve headerApi expectsString)) $ do

353352 let delete' x = Test.Hspec.Wai.request methodDelete x [("MyHeader", "more from you")]

354353

355354 it "passes the header to the handler (String)" $

@@ -373,7 +372,7 @@ rawSpec :: Spec

373372rawSpec = do

374373 describe "Servant.API.Raw" $ do

375374 it "runs applications" $ do

376− (flip runSession) (serve rawApi EmptyConfig (rawApplication (const (42 :: Integer)))) $ do

375+ (flip runSession) (serve rawApi (rawApplication (const (42 :: Integer)))) $ do

377376 response <- Network.Wai.Test.request defaultRequest{

378377 pathInfo = ["foo"]

379378 }

@@ -381,7 +380,7 @@ rawSpec = do

381380 simpleBody response `shouldBe` "42"

382381

383382 it "gets the pathInfo modified" $ do

384− (flip runSession) (serve rawApi EmptyConfig (rawApplication pathInfo)) $ do

383+ (flip runSession) (serve rawApi (rawApplication pathInfo)) $ do

385384 response <- Network.Wai.Test.request defaultRequest{

386385 pathInfo = ["foo", "bar"]

387386 }

@@ -415,7 +414,7 @@ alternativeServer =

415414alternativeSpec :: Spec

416415alternativeSpec = do

417416 describe "Servant.API.Alternative" $ do

418− with (return $ serve alternativeApi EmptyConfig alternativeServer) $ do

417+ with (return $ serve alternativeApi alternativeServer) $ do

419418

420419 it "unions endpoints" $ do

421420 response <- get "/foo"

@@ -450,7 +449,7 @@ responseHeadersServer = let h = return $ addHeader 5 $ addHeader "kilroy" "hi"

450449

451450responseHeadersSpec :: Spec

452451responseHeadersSpec = describe "ResponseHeaders" $ do

453− with (return $ serve (Proxy :: Proxy ResponseHeadersApi) EmptyConfig responseHeadersServer) $ do

452+ with (return $ serve (Proxy :: Proxy ResponseHeadersApi) responseHeadersServer) $ do

454453

455454 let methods = [methodGet, methodPost, methodPut, methodPatch]

456455

@@ -516,7 +515,7 @@ miscServ = versionHandler

516515 hostHandler = return . show

517516

518517miscCombinatorSpec :: Spec

519−miscCombinatorSpec = with (return $ serve miscApi EmptyConfig miscServ) $

518+miscCombinatorSpec = with (return $ serve miscApi miscServ) $

520519 describe "Misc. combinators for request inspection" $ do

521520 it "Successfully gets the HTTP version specified in the request" $

522521 go "/version" "\"HTTP/1.0\""

servant-server/test/Servant/Utils/StaticFilesSpec.hs+2−2

@@ -16,7 +16,7 @@ import Test.Hspec (Spec, around_, describe, it)

1616import Test.Hspec.Wai (get, shouldRespondWith, with)

1717

1818import Servant.API ((:<|>) ((:<|>)), Capture, Get, Raw, (:>), JSON)

19−import Servant.Server (Server, serve, Config(EmptyConfig))

19+import Servant.Server (Server, serve)

2020import Servant.ServerSpec (Person (Person))

2121import Servant.Utils.StaticFiles (serveDirectory)

2222

@@ -29,7 +29,7 @@ api :: Proxy Api

2929api = Proxy

3030

3131app :: Application

32−app = serve api EmptyConfig server

32+app = serve api server

3333

3434server :: Server Api

3535server =