servant-server 0.7.1 → 0.8
raw patch · 7 files changed
+104/−97 lines, 7 filesdep ~basedep ~filepathdep ~mtl
Dependency ranges changed: base, filepath, mtl, servant, transformers-compat, wai-app-static
Files
- example/greet.hs +2/−2
- servant-server.cabal +10/−10
- src/Servant/Server.hs +10/−7
- src/Servant/Server/Internal.hs +39/−39
- src/Servant/Server/Internal/ServantErr.hs +30/−30
- test/Servant/Server/RouterSpec.hs +2/−2
- test/Servant/ServerSpec.hs +11/−7
example/greet.hs view
@@ -34,7 +34,7 @@ :<|> "greet" :> ReqBody '[JSON] Greet :> Post '[JSON] Greet -- DELETE /greet/:greetid- :<|> "greet" :> Capture "greetid" Text :> Delete '[JSON] ()+ :<|> "greet" :> Capture "greetid" Text :> Delete '[JSON] NoContent testApi :: Proxy TestApi testApi = Proxy@@ -54,7 +54,7 @@ postGreetH greet = return greet - deleteGreetH _ = return ()+ deleteGreetH _ = return NoContent -- Turn the server into a WAI app. 'serve' is provided by servant, -- more precisely by the Servant.Server module.
servant-server.cabal view
@@ -1,5 +1,5 @@ name: servant-server-version: 0.7.1+version: 0.8 synopsis: A family of combinators for defining webservices APIs and serving them description: A family of combinators for defining webservices APIs and serving them@@ -45,31 +45,31 @@ Servant.Server.Internal.ServantErr Servant.Utils.StaticFiles build-depends:- base >= 4.7 && < 5- , base-compat >= 0.9+ base >= 4.7 && < 4.10+ , base-compat >= 0.9 && < 0.10 , aeson >= 0.7 && < 0.12 , attoparsec >= 0.12 && < 0.14- , base64-bytestring == 1.0.*+ , base64-bytestring >= 1.0 && < 1.1 , bytestring >= 0.10 && < 0.11 , containers >= 0.5 && < 0.6 , http-api-data >= 0.1 && < 0.3 , http-types >= 0.8 && < 0.10 , network-uri >= 2.6 && < 2.7- , mtl >= 2 && < 3+ , mtl >= 2 && < 2.3 , network >= 2.6 && < 2.7 , safe >= 0.3 && < 0.4- , servant == 0.7.*+ , servant == 0.8.* , split >= 0.2 && < 0.3 , string-conversions >= 0.3 && < 0.5 , system-filepath >= 0.4 && < 0.5- , filepath >= 1+ , filepath >= 1 && < 1.5 , text >= 1.2 && < 1.3 , transformers >= 0.3 && < 0.6- , transformers-compat>= 0.4+ , transformers-compat>= 0.4 && < 0.6 , wai >= 3.0 && < 3.3- , wai-app-static >= 3.0 && < 3.2+ , wai-app-static >= 3.1 && < 3.2 , warp >= 3.0 && < 3.3- , word8 == 0.1.*+ , word8 >= 0.1 && < 0.2 hs-source-dirs: src default-language: Haskell2010
src/Servant/Server.hs view
@@ -95,6 +95,9 @@ , err504 , err505 + -- * Re-exports+ , Application+ ) where import Data.Proxy (Proxy)@@ -127,11 +130,11 @@ -- > main :: IO () -- > main = Network.Wai.Handler.Warp.run 8080 app ---serve :: (HasServer layout '[]) => Proxy layout -> Server layout -> Application+serve :: (HasServer api '[]) => Proxy api -> Server api -> Application serve p = serveWithContext p EmptyContext -serveWithContext :: (HasServer layout context)- => Proxy layout -> Context context -> Server layout -> Application+serveWithContext :: (HasServer api context)+ => Proxy api -> Context context -> Server api -> Application serveWithContext p context server = toApplication (runRouter (route p context (emptyDelayed (Route server)))) @@ -144,7 +147,7 @@ -- For the following API -- -- > type API =--- > "a" :> "d" :> Get '[JSON] ()+-- > "a" :> "d" :> Get '[JSON] NoContent -- > :<|> "b" :> Capture "x" Int :> Get '[JSON] Bool -- > :<|> "c" :> Put '[JSON] Bool -- > :<|> "a" :> "e" :> Get '[JSON] Int@@ -186,12 +189,12 @@ -- that one takes precedence. If both parts fail, the \"better\" error -- code will be returned. ---layout :: (HasServer layout '[]) => Proxy layout -> Text+layout :: (HasServer api '[]) => Proxy api -> Text layout p = layoutWithContext p EmptyContext -- | Variant of 'layout' that takes an additional 'Context'.-layoutWithContext :: (HasServer layout context)- => Proxy layout -> Context context -> Text+layoutWithContext :: (HasServer api context)+ => Proxy api -> Context context -> Text layoutWithContext p context = routerLayout (route p context (emptyDelayed (FailFatal err501)))
src/Servant/Server/Internal.hs view
@@ -68,16 +68,16 @@ import Servant.Server.Internal.ServantErr -class HasServer layout context where- type ServerT layout (m :: * -> *) :: *+class HasServer api context where+ type ServerT api (m :: * -> *) :: * route ::- Proxy layout+ Proxy api -> Context context- -> Delayed env (Server layout)+ -> Delayed env (Server api) -> Router env -type Server layout = ServerT layout Handler+type Server api = ServerT api Handler -- * Instances @@ -118,15 +118,15 @@ -- > server = getBook -- > where getBook :: Text -> Handler Book -- > getBook isbn = ...-instance (KnownSymbol capture, FromHttpApiData a, HasServer sublayout context)- => HasServer (Capture capture a :> sublayout) context where+instance (KnownSymbol capture, FromHttpApiData a, HasServer api context)+ => HasServer (Capture capture a :> api) context where - type ServerT (Capture capture a :> sublayout) m =- a -> ServerT sublayout m+ type ServerT (Capture capture a :> api) m =+ a -> ServerT api m route Proxy context d = CaptureRouter $- route (Proxy :: Proxy sublayout)+ route (Proxy :: Proxy api) context (addCapture d $ \ txt -> case parseUrlPieceMaybe txt :: Maybe a of Nothing -> delayedFail err400@@ -236,15 +236,15 @@ -- > server = viewReferer -- > where viewReferer :: Referer -> Handler referer -- > viewReferer referer = return referer-instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout context)- => HasServer (Header sym a :> sublayout) context where+instance (KnownSymbol sym, FromHttpApiData a, HasServer api context)+ => HasServer (Header sym a :> api) context where - type ServerT (Header sym a :> sublayout) m =- Maybe a -> ServerT sublayout m+ type ServerT (Header sym a :> api) m =+ Maybe a -> ServerT api m route Proxy context subserver = let mheader req = parseHeaderMaybe =<< lookup str (requestHeaders req)- in route (Proxy :: Proxy sublayout) context (passToServer subserver mheader)+ in route (Proxy :: Proxy api) context (passToServer subserver mheader) where str = fromString $ symbolVal (Proxy :: Proxy sym) -- | If you use @'QueryParam' "author" Text@ in one of the endpoints for your API,@@ -268,11 +268,11 @@ -- > where getBooksBy :: Maybe Text -> Handler [Book] -- > getBooksBy Nothing = ...return all books... -- > getBooksBy (Just author) = ...return books by the given author...-instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout context)- => HasServer (QueryParam sym a :> sublayout) context where+instance (KnownSymbol sym, FromHttpApiData a, HasServer api context)+ => HasServer (QueryParam sym a :> api) context where - type ServerT (QueryParam sym a :> sublayout) m =- Maybe a -> ServerT sublayout m+ type ServerT (QueryParam sym a :> api) m =+ Maybe a -> ServerT api m route Proxy context subserver = let querytext r = parseQueryText $ rawQueryString r@@ -282,7 +282,7 @@ 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) context (passToServer subserver param)+ in route (Proxy :: Proxy api) context (passToServer subserver param) where paramname = cs $ symbolVal (Proxy :: Proxy sym) -- | If you use @'QueryParams' "authors" Text@ in one of the endpoints for your API,@@ -304,11 +304,11 @@ -- > server = getBooksBy -- > where getBooksBy :: [Text] -> Handler [Book] -- > getBooksBy authors = ...return all books by these authors...-instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout context)- => HasServer (QueryParams sym a :> sublayout) context where+instance (KnownSymbol sym, FromHttpApiData a, HasServer api context)+ => HasServer (QueryParams sym a :> api) context where - type ServerT (QueryParams sym a :> sublayout) m =- [a] -> ServerT sublayout m+ type ServerT (QueryParams sym a :> api) m =+ [a] -> ServerT api m route Proxy context subserver = let querytext r = parseQueryText $ rawQueryString r@@ -317,7 +317,7 @@ -- corresponding values parameters r = filter looksLikeParam (querytext r) values r = mapMaybe (convert . snd) (parameters r)- in route (Proxy :: Proxy sublayout) context (passToServer subserver values)+ in route (Proxy :: Proxy api) context (passToServer subserver values) where paramname = cs $ symbolVal (Proxy :: Proxy sym) looksLikeParam (name, _) = name == paramname || name == (paramname <> "[]") convert Nothing = Nothing@@ -335,11 +335,11 @@ -- > server = getBooks -- > where getBooks :: Bool -> Handler [Book] -- > getBooks onlyPublished = ...return all books, or only the ones that are already published, depending on the argument...-instance (KnownSymbol sym, HasServer sublayout context)- => HasServer (QueryFlag sym :> sublayout) context where+instance (KnownSymbol sym, HasServer api context)+ => HasServer (QueryFlag sym :> api) context where - type ServerT (QueryFlag sym :> sublayout) m =- Bool -> ServerT sublayout m+ type ServerT (QueryFlag sym :> api) m =+ Bool -> ServerT api m route Proxy context subserver = let querytext r = parseQueryText $ rawQueryString r@@ -347,7 +347,7 @@ 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) context (passToServer subserver param)+ in route (Proxy :: Proxy api) context (passToServer subserver param) where paramname = cs $ symbolVal (Proxy :: Proxy sym) examine v | v == "true" || v == "1" || v == "" = True | otherwise = False@@ -392,14 +392,14 @@ -- > server = postBook -- > where postBook :: Book -> Handler Book -- > postBook book = ...insert into your db...-instance ( AllCTUnrender list a, HasServer sublayout context- ) => HasServer (ReqBody list a :> sublayout) context where+instance ( AllCTUnrender list a, HasServer api context+ ) => HasServer (ReqBody list a :> api) context where - type ServerT (ReqBody list a :> sublayout) m =- a -> ServerT sublayout m+ type ServerT (ReqBody list a :> api) m =+ a -> ServerT api m route Proxy context subserver =- route (Proxy :: Proxy sublayout) context (addBodyCheck subserver bodyCheck)+ route (Proxy :: Proxy api) context (addBodyCheck subserver bodyCheck) where bodyCheck = withRequest $ \ request -> do -- See HTTP RFC 2616, section 7.2.1@@ -416,15 +416,15 @@ Just (Right v) -> return v -- | Make sure the incoming request starts with @"/path"@, strip it and--- pass the rest of the request path to @sublayout@.-instance (KnownSymbol path, HasServer sublayout context) => HasServer (path :> sublayout) context where+-- pass the rest of the request path to @api@.+instance (KnownSymbol path, HasServer api context) => HasServer (path :> api) context where - type ServerT (path :> sublayout) m = ServerT sublayout m+ type ServerT (path :> api) m = ServerT api m route Proxy context subserver = pathRouter (cs (symbolVal proxyPath))- (route (Proxy :: Proxy sublayout) context subserver)+ (route (Proxy :: Proxy api) context subserver) where proxyPath = Proxy :: Proxy path instance HasServer api context => HasServer (RemoteHost :> api) context where
src/Servant/Server/Internal/ServantErr.hs view
@@ -31,7 +31,7 @@ -- Example: -- -- > failingHandler :: Handler ()--- > failingHandler = throwErr $ err300 { errBody = "I can't choose." }+-- > failingHandler = throwError $ err300 { errBody = "I can't choose." } -- err300 :: ServantErr err300 = ServantErr { errHTTPCode = 300@@ -45,7 +45,7 @@ -- Example: -- -- > failingHandler :: Handler ()--- > failingHandler = throwErr err301+-- > failingHandler = throwError err301 -- err301 :: ServantErr err301 = ServantErr { errHTTPCode = 301@@ -59,7 +59,7 @@ -- Example: -- -- > failingHandler :: Handler ()--- > failingHandler = throwErr err302+-- > failingHandler = throwError err302 -- err302 :: ServantErr err302 = ServantErr { errHTTPCode = 302@@ -73,7 +73,7 @@ -- Example: -- -- > failingHandler :: Handler ()--- > failingHandler = throwErr err303+-- > failingHandler = throwError err303 -- err303 :: ServantErr err303 = ServantErr { errHTTPCode = 303@@ -87,7 +87,7 @@ -- Example: -- -- > failingHandler :: Handler ()--- > failingHandler = throwErr err304+-- > failingHandler = throwError err304 -- err304 :: ServantErr err304 = ServantErr { errHTTPCode = 304@@ -101,7 +101,7 @@ -- Example: -- -- > failingHandler :: Handler ()--- > failingHandler = throwErr err305+-- > failingHandler = throwError err305 -- err305 :: ServantErr err305 = ServantErr { errHTTPCode = 305@@ -115,7 +115,7 @@ -- Example: -- -- > failingHandler :: Handler ()--- > failingHandler = throwErr err307+-- > failingHandler = throwError err307 -- err307 :: ServantErr err307 = ServantErr { errHTTPCode = 307@@ -129,7 +129,7 @@ -- Example: -- -- > failingHandler :: Handler ()--- > failingHandler = throwErr $ err400 { errBody = "Your request makes no sense to me." }+-- > failingHandler = throwError $ err400 { errBody = "Your request makes no sense to me." } -- err400 :: ServantErr err400 = ServantErr { errHTTPCode = 400@@ -143,7 +143,7 @@ -- Example: -- -- > failingHandler :: Handler ()--- > failingHandler = throwErr $ err401 { errBody = "Your credentials are invalid." }+-- > failingHandler = throwError $ err401 { errBody = "Your credentials are invalid." } -- err401 :: ServantErr err401 = ServantErr { errHTTPCode = 401@@ -157,7 +157,7 @@ -- Example: -- -- > failingHandler :: Handler ()--- > failingHandler = throwErr $ err402 { errBody = "You have 0 credits. Please give me $$$." }+-- > failingHandler = throwError $ err402 { errBody = "You have 0 credits. Please give me $$$." } -- err402 :: ServantErr err402 = ServantErr { errHTTPCode = 402@@ -171,7 +171,7 @@ -- Example: -- -- > failingHandler :: Handler ()--- > failingHandler = throwErr $ err403 { errBody = "Please login first." }+-- > failingHandler = throwError $ err403 { errBody = "Please login first." } -- err403 :: ServantErr err403 = ServantErr { errHTTPCode = 403@@ -185,7 +185,7 @@ -- Example: -- -- > failingHandler :: Handler ()--- > failingHandler = throwErr $ err404 { errBody = "(╯°□°）╯︵ ┻━┻)." }+-- > failingHandler = throwError $ err404 { errBody = "(╯°□°）╯︵ ┻━┻)." } -- err404 :: ServantErr err404 = ServantErr { errHTTPCode = 404@@ -199,7 +199,7 @@ -- Example: -- -- > failingHandler :: Handler ()--- > failingHandler = throwErr $ err405 { errBody = "Your account privileges does not allow for this. Please pay $$$." }+-- > failingHandler = throwError $ err405 { errBody = "Your account privileges does not allow for this. Please pay $$$." } -- err405 :: ServantErr err405 = ServantErr { errHTTPCode = 405@@ -213,7 +213,7 @@ -- Example: -- -- > failingHandler :: Handler ()--- > failingHandler = throwErr err406+-- > failingHandler = throwError err406 -- err406 :: ServantErr err406 = ServantErr { errHTTPCode = 406@@ -227,7 +227,7 @@ -- Example: -- -- > failingHandler :: Handler ()--- > failingHandler = throwErr err407+-- > failingHandler = throwError err407 -- err407 :: ServantErr err407 = ServantErr { errHTTPCode = 407@@ -241,7 +241,7 @@ -- Example: -- -- > failingHandler :: Handler ()--- > failingHandler = throwErr $ err409 { errBody = "Transaction conflicts with 59879cb56c7c159231eeacdd503d755f7e835f74" }+-- > failingHandler = throwError $ err409 { errBody = "Transaction conflicts with 59879cb56c7c159231eeacdd503d755f7e835f74" } -- err409 :: ServantErr err409 = ServantErr { errHTTPCode = 409@@ -255,7 +255,7 @@ -- Example: -- -- > failingHandler :: Handler ()--- > failingHandler = throwErr $ err410 { errBody = "I know it was here at some point, but.. I blame bad luck." }+-- > failingHandler = throwError $ err410 { errBody = "I know it was here at some point, but.. I blame bad luck." } -- err410 :: ServantErr err410 = ServantErr { errHTTPCode = 410@@ -269,7 +269,7 @@ -- Example: -- -- > failingHandler :: Handler ()--- > failingHandler = throwErr err411+-- > failingHandler = throwError err411 -- err411 :: ServantErr err411 = ServantErr { errHTTPCode = 411@@ -283,7 +283,7 @@ -- Example: -- -- > failingHandler :: Handler ()--- > failingHandler = throwErr $ err412 { errBody = "Precondition fail: x < 42 && y > 57" }+-- > failingHandler = throwError $ err412 { errBody = "Precondition fail: x < 42 && y > 57" } -- err412 :: ServantErr err412 = ServantErr { errHTTPCode = 412@@ -297,7 +297,7 @@ -- Example: -- -- > failingHandler :: Handler ()--- > failingHandler = throwErr $ err413 { errBody = "Request exceeded 64k." }+-- > failingHandler = throwError $ err413 { errBody = "Request exceeded 64k." } -- err413 :: ServantErr err413 = ServantErr { errHTTPCode = 413@@ -311,7 +311,7 @@ -- Example: -- -- > failingHandler :: Handler ()--- > failingHandler = throwErr $ err414 { errBody = "Maximum length is 64." }+-- > failingHandler = throwError $ err414 { errBody = "Maximum length is 64." } -- err414 :: ServantErr err414 = ServantErr { errHTTPCode = 414@@ -325,7 +325,7 @@ -- Example: -- -- > failingHandler :: Handler ()--- > failingHandler = throwErr $ err415 { errBody = "Supported media types: gif, png" }+-- > failingHandler = throwError $ err415 { errBody = "Supported media types: gif, png" } -- err415 :: ServantErr err415 = ServantErr { errHTTPCode = 415@@ -339,7 +339,7 @@ -- Example: -- -- > failingHandler :: Handler ()--- > failingHandler = throwErr $ err416 { errBody = "Valid range is [0, 424242]." }+-- > failingHandler = throwError $ err416 { errBody = "Valid range is [0, 424242]." } -- err416 :: ServantErr err416 = ServantErr { errHTTPCode = 416@@ -353,7 +353,7 @@ -- Example: -- -- > failingHandler :: Handler ()--- > failingHandler = throwErr $ err417 { errBody = "I found a quux in the request. This isn't going to work." }+-- > failingHandler = throwError $ err417 { errBody = "I found a quux in the request. This isn't going to work." } -- err417 :: ServantErr err417 = ServantErr { errHTTPCode = 417@@ -367,7 +367,7 @@ -- Example: -- -- > failingHandler :: Handler ()--- > failingHandler = throwErr $ err500 { errBody = "Exception in module A.B.C:55. Have a great day!" }+-- > failingHandler = throwError $ err500 { errBody = "Exception in module A.B.C:55. Have a great day!" } -- err500 :: ServantErr err500 = ServantErr { errHTTPCode = 500@@ -381,7 +381,7 @@ -- Example: -- -- > failingHandler :: Handler ()--- > failingHandler = throwErr $ err501 { errBody = "/v1/foo is not supported with quux in the request." }+-- > failingHandler = throwError $ err501 { errBody = "/v1/foo is not supported with quux in the request." } -- err501 :: ServantErr err501 = ServantErr { errHTTPCode = 501@@ -395,7 +395,7 @@ -- Example: -- -- > failingHandler :: Handler ()--- > failingHandler = throwErr $ err502 { errBody = "Tried gateway foo, bar, and baz. None responded." }+-- > failingHandler = throwError $ err502 { errBody = "Tried gateway foo, bar, and baz. None responded." } -- err502 :: ServantErr err502 = ServantErr { errHTTPCode = 502@@ -409,7 +409,7 @@ -- Example: -- -- > failingHandler :: Handler ()--- > failingHandler = throwErr $ err503 { errBody = "We're rewriting in PHP." }+-- > failingHandler = throwError $ err503 { errBody = "We're rewriting in PHP." } -- err503 :: ServantErr err503 = ServantErr { errHTTPCode = 503@@ -423,7 +423,7 @@ -- Example: -- -- > failingHandler :: Handler ()--- > failingHandler = throwErr $ err504 { errBody = "Backend foobar did not respond in 5 seconds." }+-- > failingHandler = throwError $ err504 { errBody = "Backend foobar did not respond in 5 seconds." } -- err504 :: ServantErr err504 = ServantErr { errHTTPCode = 504@@ -437,7 +437,7 @@ -- Example usage: -- -- > failingHandler :: Handler ()--- > failingHandler = throwErr $ err505 { errBody = "I support HTTP/4.0 only." }+-- > failingHandler = throwError $ err505 { errBody = "I support HTTP/4.0 only." } -- err505 :: ServantErr err505 = ServantErr { errHTTPCode = 505
test/Servant/Server/RouterSpec.hs view
@@ -8,7 +8,7 @@ import Data.Proxy (Proxy(..)) import Data.Text (unpack) import Network.HTTP.Types (Status (..))-import Network.Wai (Application, responseBuilder)+import Network.Wai (responseBuilder) import Network.Wai.Internal (Response (ResponseBuilder)) import Test.Hspec import Test.Hspec.Wai (get, shouldRespondWith, with)@@ -74,7 +74,7 @@ makeTrivialRouter p = route p EmptyContext (emptyDelayed (FailFatal err501)) -type End = Get '[JSON] ()+type End = Get '[JSON] NoContent -- The latter version looks more efficient, -- but the former should be compiled to the
test/Servant/ServerSpec.hs view
@@ -340,19 +340,23 @@ -- * headerSpec {{{ ------------------------------------------------------------------------------ -type HeaderApi a = Header "MyHeader" a :> Delete '[JSON] ()+type HeaderApi a = Header "MyHeader" a :> Delete '[JSON] NoContent headerApi :: Proxy (HeaderApi a) headerApi = Proxy headerSpec :: Spec headerSpec = describe "Servant.API.Header" $ do - let expectsInt :: Maybe Int -> Handler ()- expectsInt (Just x) = when (x /= 5) $ error "Expected 5"+ let expectsInt :: Maybe Int -> Handler NoContent+ expectsInt (Just x) = do+ when (x /= 5) $ error "Expected 5"+ return NoContent expectsInt Nothing = error "Expected an int" - let expectsString :: Maybe String -> Handler ()- expectsString (Just x) = when (x /= "more from you") $ error "Expected more from you"+ let expectsString :: Maybe String -> Handler NoContent+ expectsString (Just x) = do+ when (x /= "more from you") $ error "Expected more from you"+ return NoContent expectsString Nothing = error "Expected a string" with (return (serve headerApi expectsInt)) $ do@@ -410,7 +414,7 @@ :<|> "foo" :> Get '[PlainText] T.Text :<|> "bar" :> Post '[JSON] Animal :<|> "bar" :> Put '[JSON] Animal- :<|> "bar" :> Delete '[JSON] ()+ :<|> "bar" :> Delete '[JSON] NoContent alternativeApi :: Proxy AlternativeApi alternativeApi = Proxy@@ -422,7 +426,7 @@ :<|> return "a string" :<|> return jerry :<|> return jerry- :<|> return ()+ :<|> return NoContent alternativeSpec :: Spec alternativeSpec = do