servant-server 0.13.0.1 → 0.14

raw patch · 6 files changed

+174/−110 lines, 6 filesdep −attoparsecdep −parsecdep −splitdep ~QuickCheckdep ~aesondep ~base-compatPVP ok

version bump matches the API change (PVP)

Dependencies removed: attoparsec, parsec, split, system-filepath

Dependency ranges changed: QuickCheck, aeson, base-compat, doctest, exceptions, hspec, hspec-wai, http-api-data, http-media, http-types, monad-control, network, resourcet, safe, semigroups, servant, temporary, transformers-compat, warp

API changes (from Hackage documentation)

Files

• CHANGELOG.md +46/−0
• servant-server.cabal +30/−38
• src/Servant/Server/Internal.hs +20/−17
• src/Servant/Utils/StaticFiles.hs +7/−7
• test/Servant/Server/ErrorSpec.hs +11/−2
• test/Servant/ServerSpec.hs +60/−46

@@ -1,6 +1,52 @@ [The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-server/CHANGELOG.md) [Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md) +0.14+----++- `Stream` takes a status code argument++  ```diff+  -Stream method        framing ctype a+  +Stream method status framing ctype a+  ```++  ([#966](https://github.com/haskell-servant/servant/pull/966)+   [#972](https://github.com/haskell-servant/servant/pull/972))++- `ToStreamGenerator` definition changed, so it's possible to write an instance+  for conduits.++  ```diff+  -class ToStreamGenerator f a where+  -   toStreamGenerator :: f a -> StreamGenerator a+  +class ToStreamGenerator a b | a -> b where+  +   toStreamGenerator :: a -> StreamGenerator b+  ```++  ([#959](https://github.com/haskell-servant/servant/pull/959))++- Added `NoFraming` streaming strategy+  ([#959](https://github.com/haskell-servant/servant/pull/959))++- *servant-server* File serving in polymorphic monad.+  i.e. Generalised types of `serveDirectoryFileServer` etc functions in+  `Servant.Utils.StaticFiles`+  ([#953](https://github.com/haskell-servant/servant/pull/953))++- *servant-server* `ReqBody` content type check is recoverable.+  This allows writing APIs like:++  ```haskell+        ReqBody '[JSON] Int      :> Post '[PlainText] Int+  :<|>  ReqBody '[PlainText] Int :> Post '[PlainText] Int+  ```++  which is useful when handlers are subtly different,+  for example may do less work.+  ([#937](https://github.com/haskell-servant/servant/pull/937))++ 0.13.0.1 -------- 

@@ -1,5 +1,5 @@ name:                servant-server-version:             0.13.0.1+version:             0.14 synopsis:            A family of combinators for defining webservices APIs and serving them description:   A family of combinators for defining webservices APIs and serving them@@ -22,11 +22,11 @@ build-type:          Custom cabal-version:       >=1.10 tested-with:-  GHC==7.8.4,-  GHC==7.10.3,-  GHC==8.0.2,-  GHC==8.2.2,-  GHC==8.4.1+  GHC==7.8.4+  GHC==7.10.3+  GHC==8.0.2+  GHC==8.2.2+  GHC==8.4.3 extra-source-files:   include/*.h   CHANGELOG.md@@ -40,7 +40,7 @@   setup-depends:     base >= 4 && <5,     Cabal,-    cabal-doctest >= 1.0.1 && <1.1+    cabal-doctest >= 1.0.6 && <1.1  library   exposed-modules:@@ -71,37 +71,31 @@    if !impl(ghc >= 8.0)     build-depends:-      semigroups            >= 0.18.3 && < 0.19+      semigroups            >= 0.18.4 && < 0.19    -- Servant dependencies   build-depends:-      servant            == 0.13.*+      servant            == 0.14.*    -- Other dependencies: Lower bound around what is in the latest Stackage LTS.   -- Here can be exceptions if we really need features from the newer versions.   build-depends:-      aeson               >= 1.2.3.0  && < 1.4-    , base-compat         >= 0.9.3    && < 0.11-    , attoparsec          >= 0.13.2.0 && < 0.14+      base-compat         >= 0.10.1   && < 0.11     , base64-bytestring   >= 1.0.0.1  && < 1.1-    , exceptions          >= 0.8.3    && < 0.11-    , http-api-data       >= 0.3.7.1  && < 0.4-    , http-media          >= 0.7.0    && < 0.8-    , http-types          >= 0.12     && < 0.13+    , exceptions          >= 0.10.0   && < 0.11+    , http-api-data       >= 0.3.8.1  && < 0.4+    , http-media          >= 0.7.1.2  && < 0.8+    , http-types          >= 0.12.1   && < 0.13     , network-uri         >= 2.6.1.0  && < 2.7-    , monad-control       >= 1.0.0.4  && < 1.1-    , network             >= 2.6.3.2  && < 2.7-    , safe                >= 0.3.15   && < 0.4-    , split               >= 0.2.3.2  && < 0.3+    , monad-control       >= 1.0.2.3  && < 1.1+    , network             >= 2.6.3.5  && < 2.8     , string-conversions  >= 0.4.0.1  && < 0.5-    , system-filepath     >= 0.4      && < 0.5-    , resourcet           >= 1.1.9    && < 1.3+    , resourcet           >= 1.1.11   && < 1.3     , tagged              >= 0.8.5    && < 0.9     , transformers-base   >= 0.4.4    && < 0.5-    , transformers-compat >= 0.5.1    && < 0.7+    , transformers-compat >= 0.6.2    && < 0.7     , wai                 >= 3.2.1.1  && < 3.3     , wai-app-static      >= 3.1.6.1  && < 3.2-    , warp                >= 3.2.13   && < 3.3     , word8               >= 0.1.3    && < 0.2    hs-source-dirs: src@@ -120,11 +114,13 @@       base     , servant     , servant-server-    , aeson-    , warp     , wai     , text +  build-depends:+      aeson               >= 1.3.1.1  && < 1.5+    , warp                >= 3.2.13   && < 3.3+ test-suite spec   type: exitcode-stdio-1.0   ghc-options: -Wall@@ -148,13 +144,10 @@   build-depends:       base     , base-compat-    , aeson     , base64-bytestring     , bytestring-    , exceptions     , http-types     , mtl-    , network     , resourcet     , safe     , servant@@ -164,27 +157,26 @@     , transformers     , transformers-compat     , wai-    , warp    -- Additonal dependencies   build-depends:-      directory            >= 1.2.1.0  && < 1.4-    , hspec                >= 2.4.4    && < 2.6-    , hspec-wai            >= 0.9      && < 0.10+      aeson                >= 1.3.1.1  && < 1.5+    , directory            >= 1.2.1.0  && < 1.4+    , hspec                >= 2.5.1    && < 2.6+    , hspec-wai            >= 0.9.0    && < 0.10+    , QuickCheck           >= 2.11.3   && < 2.12     , should-not-typecheck >= 2.1.0    && < 2.2-    , parsec               >= 3.1.11   && < 3.2-    , QuickCheck           >= 2.10.1   && < 2.12+    , temporary            >= 1.3      && < 1.4     , wai-extra            >= 3.0.21.0 && < 3.1-    , temporary            >= 1.2.0.3  && < 1.4    build-tool-depends:-    hspec-discover:hspec-discover >=2.4.4 && <2.6+    hspec-discover:hspec-discover >= 2.5.1 && <2.6  test-suite doctests   build-depends:       base     , servant-server-    , doctest >= 0.13.0 && <0.16+    , doctest >= 0.15.0 && <0.16   type: exitcode-stdio-1.0   main-is: test/doctests.hs   buildable: True

@@ -283,37 +283,40 @@   instance OVERLAPPABLE_-         ( MimeRender ctype a, ReflectMethod method,-           FramingRender framing ctype, ToStreamGenerator f a-         ) => HasServer (Stream method framing ctype (f a)) context where+         ( MimeRender ctype a, ReflectMethod method, KnownNat status,+           FramingRender framing ctype, ToStreamGenerator b a+         ) => HasServer (Stream method status framing ctype b) context where -  type ServerT (Stream method framing ctype (f a)) m = m (f a)+  type ServerT (Stream method status framing ctype b) m = m b   hoistServerWithContext _ _ nt s = nt s -  route Proxy _ = streamRouter ([],) method (Proxy :: Proxy framing) (Proxy :: Proxy ctype)+  route Proxy _ = streamRouter ([],) method status (Proxy :: Proxy framing) (Proxy :: Proxy ctype)       where method = reflectMethod (Proxy :: Proxy method)+            status = toEnum . fromInteger $ natVal (Proxy :: Proxy status)  instance OVERLAPPING_-         ( MimeRender ctype a, ReflectMethod method,-           FramingRender framing ctype, ToStreamGenerator f a,-           GetHeaders (Headers h (f a))-         ) => HasServer (Stream method framing ctype (Headers h (f a))) context where+         ( MimeRender ctype a, ReflectMethod method, KnownNat status,+           FramingRender framing ctype, ToStreamGenerator b a,+           GetHeaders (Headers h b)+         ) => HasServer (Stream method status framing ctype (Headers h b)) context where -  type ServerT (Stream method framing ctype (Headers h (f a))) m = m (Headers h (f a))+  type ServerT (Stream method status framing ctype (Headers h b)) m = m (Headers h b)   hoistServerWithContext _ _ nt s = nt s -  route Proxy _ = streamRouter (\x -> (getHeaders x, getResponse x)) method (Proxy :: Proxy framing) (Proxy :: Proxy ctype)+  route Proxy _ = streamRouter (\x -> (getHeaders x, getResponse x)) method status (Proxy :: Proxy framing) (Proxy :: Proxy ctype)       where method = reflectMethod (Proxy :: Proxy method)+            status = toEnum . fromInteger $ natVal (Proxy :: Proxy status)  -streamRouter :: (MimeRender ctype a, FramingRender framing ctype, ToStreamGenerator f a) =>-                (b -> ([(HeaderName, B.ByteString)], f a))+streamRouter :: (MimeRender ctype a, FramingRender framing ctype, ToStreamGenerator b a) =>+                (c -> ([(HeaderName, B.ByteString)], b))              -> Method+             -> Status              -> Proxy framing              -> Proxy ctype-             -> Delayed env (Handler b)+             -> Delayed env (Handler c)              -> Router env-streamRouter splitHeaders method framingproxy ctypeproxy action = leafRouter $ \env request respond ->+streamRouter splitHeaders method status framingproxy ctypeproxy action = leafRouter $ \env request respond ->           let accH    = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request               cmediatype = NHM.matchAccept [contentType ctypeproxy] accH               accCheck = when (isNothing cmediatype) $ delayedFail err406@@ -323,7 +326,7 @@                        ) env request respond $ \ output ->                 let (headers, fa) = splitHeaders output                     k = getStreamGenerator . toStreamGenerator $ fa in-                Route $ responseStream status200 (contentHeader : headers) $ \write flush -> do+                Route $ responseStream status (contentHeader : headers) $ \write flush -> do                       write . BB.lazyByteString $ header framingproxy ctypeproxy                       case boundary framingproxy ctypeproxy of                            BoundaryStrategyBracket f ->@@ -604,7 +607,7 @@         let contentTypeH = fromMaybe "application/octet-stream"                          $ lookup hContentType $ requestHeaders request         case canHandleCTypeH (Proxy :: Proxy list) (cs contentTypeH) :: Maybe (BL.ByteString -> Either String a) of-          Nothing -> delayedFailFatal err415+          Nothing -> delayedFail err415           Just f  -> return f        -- Body check, we get a body parsing functions as the first argument.

@@ -18,7 +18,7 @@ import           Data.ByteString                (ByteString) import           Network.Wai.Application.Static import           Servant.API.Raw                (Raw)-import           Servant.Server                 (Server, Tagged (..))+import           Servant.Server                 (ServerT, Tagged (..)) import           System.FilePath                (addTrailingPathSeparator) #if !MIN_VERSION_wai_app_static(3,1,0) import           Filesystem.Path.CurrentOS      (decodeString)@@ -47,33 +47,33 @@ -- in order. -- -- Corresponds to the `defaultWebAppSettings` `StaticSettings` value.-serveDirectoryWebApp :: FilePath -> Server Raw+serveDirectoryWebApp :: FilePath -> ServerT Raw m serveDirectoryWebApp = serveDirectoryWith . defaultWebAppSettings . fixPath  -- | Same as 'serveDirectoryWebApp', but uses `defaultFileServerSettings`.-serveDirectoryFileServer :: FilePath -> Server Raw+serveDirectoryFileServer :: FilePath -> ServerT Raw m serveDirectoryFileServer = serveDirectoryWith . defaultFileServerSettings . fixPath  -- | Same as 'serveDirectoryWebApp', but uses 'webAppSettingsWithLookup'.-serveDirectoryWebAppLookup :: ETagLookup -> FilePath -> Server Raw+serveDirectoryWebAppLookup :: ETagLookup -> FilePath -> ServerT Raw m serveDirectoryWebAppLookup etag =   serveDirectoryWith . flip webAppSettingsWithLookup etag . fixPath  -- | Uses 'embeddedSettings'.-serveDirectoryEmbedded :: [(FilePath, ByteString)] -> Server Raw+serveDirectoryEmbedded :: [(FilePath, ByteString)] -> ServerT Raw m serveDirectoryEmbedded files = serveDirectoryWith (embeddedSettings files)  -- | Alias for 'staticApp'. Lets you serve a directory --   with arbitrary 'StaticSettings'. Useful when you want --   particular settings not covered by the four other --   variants. This is the most flexible method.-serveDirectoryWith :: StaticSettings -> Server Raw+serveDirectoryWith :: StaticSettings -> ServerT Raw m serveDirectoryWith = Tagged . staticApp  -- | Same as 'serveDirectoryFileServer'. It used to be the only --   file serving function in servant pre-0.10 and will be kept --   around for a few versions, but is deprecated.-serveDirectory :: FilePath -> Server Raw+serveDirectory :: FilePath -> ServerT Raw m serveDirectory = serveDirectoryFileServer {-# DEPRECATED serveDirectory "Use serveDirectoryFileServer instead" #-} 

@@ -247,6 +247,8 @@   :<|> "path3" :> ReqBody '[JSON] Int :> Post '[PlainText] Int        -- 3   :<|> "path4" :> (ReqBody '[PlainText] Int :> Post '[PlainText] Int  -- 4              :<|>  ReqBody '[PlainText] Int :> Post '[JSON] Int)      -- 5+  :<|> "path5" :> (ReqBody '[JSON] Int      :> Post '[PlainText] Int  -- 6+             :<|>  ReqBody '[PlainText] Int :> Post '[PlainText] Int) -- 7  errorChoiceApi :: Proxy ErrorChoiceApi errorChoiceApi = Proxy@@ -256,8 +258,8 @@                :<|> return 1                :<|> return 2                :<|> (\_ -> return 3)-               :<|> (\_ -> return 4)-               :<|> (\_ -> return 5)+               :<|> ((\_ -> return 4) :<|> (\_ -> return 5))+               :<|> ((\_ -> return 6) :<|> (\_ -> return 7))   errorChoiceSpec :: Spec@@ -278,6 +280,13 @@     request methodPost "path4" [(hContentType, "text/plain;charset=utf-8"),                                 (hAccept, "blah")] "5"       `shouldRespondWith` 406+  it "should respond with 415 only if none of the subservers supports the request's content type" $ do+    request methodPost "path5" [(hContentType, "text/plain;charset=utf-8")] "1"+      `shouldRespondWith` 200+    request methodPost "path5" [(hContentType, "application/json")] "1"+      `shouldRespondWith` 200+    request methodPost "path5" [(hContentType, "application/not-supported")] ""+      `shouldRespondWith` 415   -- }}}

@@ -17,57 +17,62 @@  module Servant.ServerSpec where -import           Control.Monad              (forM_, when, unless)-import           Control.Monad.Error.Class  (MonadError (..))-import           Data.Aeson                 (FromJSON, ToJSON, decode', encode)-import qualified Data.ByteString.Base64     as Base64-import           Data.Char                  (toUpper)+import           Control.Monad+                 (forM_, unless, when)+import           Control.Monad.Error.Class+                 (MonadError (..))+import           Data.Aeson+                 (FromJSON, ToJSON, decode', encode)+import qualified Data.ByteString                            as BS+import qualified Data.ByteString.Base64                     as Base64+import           Data.Char+                 (toUpper) import           Data.Monoid-import           Data.Proxy                 (Proxy (Proxy))-import           Data.String                (fromString)-import           Data.String.Conversions    (cs)-import qualified Data.Text                  as T-import           GHC.Generics               (Generic)-import           Network.HTTP.Types         (Status (..), hAccept, hContentType,-                                             methodDelete, methodGet,-                                             methodHead, methodPatch,-                                             methodPost, methodPut, ok200,-                                             imATeapot418,-                                             parseQuery)-import           Network.Wai                (Application, Request, requestHeaders, pathInfo,-                                             queryString, rawQueryString,-                                             responseLBS)-import           Network.Wai.Test           (defaultRequest, request,-                                             runSession, simpleBody,-                                             simpleHeaders, simpleStatus)-import           Servant.API                ((:<|>) (..), (:>), AuthProtect,-                                             BasicAuth, BasicAuthData(BasicAuthData),-                                             Capture, CaptureAll, Delete, Get, Header,-                                             Headers, HttpVersion,-                                             IsSecure (..), JSON,-                                             NoContent (..), Patch, PlainText,-                                             Post, Put, EmptyAPI,-                                             QueryFlag, QueryParam, QueryParams,-                                             Raw, RemoteHost, ReqBody,-                                             StdMethod (..), Verb, addHeader)+import           Data.Proxy+                 (Proxy (Proxy))+import           Data.String+                 (fromString)+import           Data.String.Conversions+                 (cs)+import qualified Data.Text                                  as T+import           GHC.Generics+                 (Generic)+import           Network.HTTP.Types+                 (Status (..), hAccept, hContentType, imATeapot418,+                 methodDelete, methodGet, methodHead, methodPatch, methodPost,+                 methodPut, ok200, parseQuery)+import           Network.Wai+                 (Application, Request, pathInfo, queryString, rawQueryString,+                 requestHeaders, responseLBS)+import           Network.Wai.Test+                 (defaultRequest, request, runSession, simpleBody,+                 simpleHeaders, simpleStatus)+import           Servant.API+                 ((:<|>) (..), (:>), AuthProtect, BasicAuth,+                 BasicAuthData (BasicAuthData), Capture, CaptureAll, Delete,+                 EmptyAPI, Get, Header, Headers, HttpVersion, IsSecure (..),+                 JSON, NoContent (..), NoFraming, OctetStream, Patch,+                 PlainText, Post, Put, QueryFlag, QueryParam, QueryParams, Raw,+                 RemoteHost, ReqBody, StdMethod (..), Stream,+                 StreamGenerator (..), Verb, addHeader) import           Servant.API.Internal.Test.ComprehensiveAPI-import           Servant.Server             (Server, Handler, Tagged (..), err401, err403,-                                             err404, serve, serveWithContext,-                                             Context((:.), EmptyContext), emptyServer)-import           Test.Hspec                 (Spec, context, describe, it,-                                             shouldBe, shouldContain)-import qualified Test.Hspec.Wai             as THW-import           Test.Hspec.Wai             (get, liftIO, matchHeaders,-                                             matchStatus, shouldRespondWith,-                                             with, (<:>))+import           Servant.Server+                 (Context ((:.), EmptyContext), Handler, Server, Tagged (..),+                 emptyServer, err401, err403, err404, serve, serveWithContext)+import           Test.Hspec+                 (Spec, context, describe, it, shouldBe, shouldContain)+import           Test.Hspec.Wai+                 (get, liftIO, matchHeaders, matchStatus, shouldRespondWith,+                 with, (<:>))+import qualified Test.Hspec.Wai                             as THW -import           Servant.Server.Internal.BasicAuth (BasicAuthCheck(BasicAuthCheck),-                                                    BasicAuthResult(Authorized,Unauthorized)) import           Servant.Server.Experimental.Auth-                                            (AuthHandler, AuthServerData,-                                             mkAuthHandler)+                 (AuthHandler, AuthServerData, mkAuthHandler)+import           Servant.Server.Internal.BasicAuth+                 (BasicAuthCheck (BasicAuthCheck),+                 BasicAuthResult (Authorized, Unauthorized)) import           Servant.Server.Internal.Context-                                            (NamedContext(..))+                 (NamedContext (..))  -- * comprehensive api test @@ -83,6 +88,7 @@ spec = do   verbSpec   captureSpec+  captureAllSpec   queryParamSpec   reqBodySpec   headerSpec@@ -105,6 +111,7 @@  :<|> "accept"    :> (    Verb method status '[JSON] Person                      :<|> Verb method status '[PlainText] String                      )+ :<|> "stream"    :> Stream method status NoFraming OctetStream (StreamGenerator BS.ByteString)  verbSpec :: Spec verbSpec = describe "Servant.API.Verb" $ do@@ -114,6 +121,8 @@           :<|> return (addHeader 5 alice)           :<|> return (addHeader 10 NoContent)           :<|> (return alice :<|> return "B")+          :<|> return (StreamGenerator $ \f _ -> f "bytestring")+       get200     = Proxy :: Proxy (VerbApi 'GET 200)       post210    = Proxy :: Proxy (VerbApi 'POST 210)       put203     = Proxy :: Proxy (VerbApi 'PUT 203)@@ -178,6 +187,11 @@             response <- THW.request method "" [] ""             liftIO $ simpleHeaders response `shouldContain`               [("Content-Type", "application/json;charset=utf-8")]++          it "works for Stream as for Result" $ do+              response <- THW.request method "/stream" [] ""+              liftIO $ statusCode (simpleStatus response) `shouldBe` status+              liftIO $ simpleBody response `shouldBe` "bytestring"    test "GET 200" get200 methodGet 200   test "POST 210" post210 methodPost 210