servant-snap 0.8.5 → 0.9.0

raw patch · 6 files changed

+57/−81 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +30/−22
• servant-snap.cabal +1/−1
• src/Servant/Server/Internal.hs +1/−1
• src/Servant/Server/Internal/RoutingApplication.hs +22/−47
• src/Servant/Server/Internal/SnapShims.hs +1/−6
• test/Servant/ServerSpec.hs +2/−4

@@ -1,78 +1,86 @@+0.9.0 (2020-09-07)+-----++ - **BREAKING** Removed `snapToApplication'`. Use `snapToApplication` instead+ - Fixed a bug that caused duplication of header values in the request data+   used to route requests. See this issue:+   [#27](https://github.com/haskell-servant/servant-snap/issues/27)+ 0.8.5.0 ----- -Bump dependencies for ghc-8.8.2+ - Bump dependencies for ghc-8.8.2   0.8.4.1 ----- -Drop servant-client and http-client dependencies from snap-greet+ - Drop servant-client and http-client dependencies from snap-greet   0.8.4 ----- -Support servant 0.15 and 0.16, which have a new `Stream` combinator-Drop support for servant < 0.15-Correct the way imperativelly added headers in request/response are managed (fixing CORS issue)-More CORS test coverage+ - Support servant 0.15 and 0.16, which have a new `Stream` combinator+ - Drop support for servant < 0.15+ - Correct the way imperativelly added headers in request/response are managed (fixing CORS issue)+ - More CORS test coverage   0.8.3.2 ----- -Backport the response header fix from 0.8.4 (we can now use it with servant 0.14)+ - Backport the response header fix from 0.8.4 (we can now use it with servant 0.14)   0.8.3 ----- -Add support for servant-0.14-Reorder handling of errors+ - Add support for servant-0.14+ - Reorder handling of errors  0.8.2 ------ -Add `HasServer` instances for `StreamGenerator`+ - Add `HasServer` instances for `StreamGenerator`   0.8.0.1 ------- -Add headers from MonadSnap state response to the servant-snap computed response-Add a commented-out snap-cors test to the test suite. It doesn't pass, although-manual testing of snap-cors works.+ - Add headers from MonadSnap state response to the servant-snap computed response+ - Add a commented-out snap-cors test to the test suite. It doesn't pass, although+   manual testing of snap-cors works.  0.8 ------- -Copy BasicAuth and Context from servant-server to support basic auth checking+ - Copy BasicAuth and Context from servant-server to support basic auth checking  0.7.1 ------- -Call 'Snap.Core.pass' when routing an empty URI path. This allows an entire-served API to fall through, which is more in line with the rest of snap routing,-and allows multiple servant API's to be served under the same path context-from 'Snap.Core.route'.+ - Call 'Snap.Core.pass' when routing an empty URI path. This allows an entire+   served API to fall through, which is more in line with the rest of snap routing,+   and allows multiple servant API's to be served under the same path context+   from 'Snap.Core.route'.  0.7.0.5 ------- -Fix throwError bug ignoring ServantError headers+ - Fix throwError bug ignoring ServantError headers  0.7.0.4 ------- -Fix throwError bug ignoring ServantError body+ - Fix throwError bug ignoring ServantError body  0.7.0.3 ------- -Bump servant upper bound, allow 0.9+ - Bump servant upper bound, allow 0.9  0.7 ---- -Initial release+ - Initial release

@@ -1,5 +1,5 @@ name:                servant-snap-version:             0.8.5+version:             0.9.0 synopsis:            A family of combinators for defining webservices APIs and serving them description:   Interpret a Servant API as a Snap server, using any Snaplets you like.

@@ -497,7 +497,7 @@   route Proxy _ rawApplication = RawRouter $ \ env request respond -> do     r <- runDelayed rawApplication env request     case r of-      Route app   -> (snapToApplication' app) request (respond . Route)+      Route app   -> (snapToApplication app) request (respond . Route)       Fail a      -> respond $ Fail a       FailFatal e -> respond $ FailFatal e 

@@ -6,32 +6,35 @@ {-# LANGUAGE KindSignatures             #-} {-# LANGUAGE MultiParamTypeClasses      #-} {-# LANGUAGE OverloadedStrings          #-}-{-# LANGUAGE RecordWildCards            #-} {-# LANGUAGE RankNTypes                 #-}+{-# LANGUAGE RecordWildCards            #-} {-# LANGUAGE ScopedTypeVariables        #-}-{-# LANGUAGE TypeOperators              #-} {-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE TypeOperators              #-} {-# LANGUAGE UndecidableInstances       #-} module Servant.Server.Internal.RoutingApplication where -import           Control.Applicative                 (Applicative(..), Alternative(..), (<$>))-import           Control.Monad                       (ap, liftM)-import           Control.Monad.IO.Class              (MonadIO, liftIO)+import           Control.Applicative                (Alternative (..),+                                                     Applicative (..), (<$>))+import           Control.Monad                      (ap, liftM)+import           Control.Monad.IO.Class             (MonadIO, liftIO) import           Control.Monad.Trans.Class-import qualified Data.ByteString                     as B-import qualified Data.ByteString.Builder             as Builder-import qualified Data.ByteString.Lazy                as BL-import           Data.CaseInsensitive                (CI)-import qualified Data.List                           as L-import           Data.Proxy                          (Proxy(..))-import           Network.HTTP.Types                  (Status(..))-import qualified System.IO.Streams                   as Streams-import           Servant.Server.Internal.SnapShims-import           Servant.Server.Internal.ServantErr+import qualified Data.ByteString                    as B+import qualified Data.ByteString.Builder            as Builder+import qualified Data.ByteString.Lazy               as BL+import           Data.CaseInsensitive               (CI)+import qualified Data.List                          as L+import           Data.Proxy                         (Proxy (..))+import           Network.HTTP.Types                 (Status (..)) import           Snap.Core-import           Snap.Internal.Http.Types            (setResponseBody)+import           Snap.Internal.Http.Types           (setResponseBody)+import qualified System.IO.Streams                  as Streams  +import           Servant.Server.Internal.ServantErr+import           Servant.Server.Internal.SnapShims++ type RoutingApplication m =      Request -- ^ the request, the field 'pathInfo' may be modified by url routing   -> (RouteResult Response -> m Response) -> m Response@@ -49,36 +52,8 @@ toApplication :: forall m. MonadSnap m => RoutingApplication m -> Application m toApplication ra request respond = do -  snapReq  <- getRequest-  r        <- ra (request `addHeaders` headers snapReq) routingRespond-  rspnd <- respond r--  -- liftIO $ putStrLn $ unlines [-  --   "----------"-  --   , "SNAP REQ"-  --   , show snapReq-  --   , "----------"-  --   , "request"-  --   , show request-  --   , "----------"-  --   , "r"-  --   , show r-  --   , "----------"-  --   , "snapResp"-  --   , show snapResp-  --   , "----------"-  --   , "rspnd"-  --   , show rspnd-  --   ]--  return rspnd--  -- snapReq  <- getRequest-  -- r        <- ra (request `addHeaders` headers snapReq) routingRespond-  -- respond r--  -- r <- ra request routingRespond-  -- respond r+  r <- ra request routingRespond+  respond r     where      routingRespond (Fail err) = case errHTTPCode err of@@ -160,7 +135,7 @@     respA <- runDelayedM a req     case respA of       Route a' -> return $ Route a'-      _ -> runDelayedM b req+      _        -> runDelayedM b req   instance MonadTrans DelayedM where

@@ -12,13 +12,8 @@  type Application m = Request -> (Response -> m Response) -> m Response -snapToApplication :: MonadSnap m => m () -> Application m+snapToApplication :: MonadSnap m => m a -> Application m snapToApplication snapAction req respond = do-  putRequest req-  snapAction >> getResponse >>= respond--snapToApplication' :: MonadSnap m => m a -> Application m-snapToApplication' snapAction req respond = do   putRequest req   snapAction >> getResponse >>= respond 

@@ -193,7 +193,6 @@                   (serveSnap api server) sInit           shouldHaveHeaders resp  [("H","5")] -        -- TODO: Why doesn't this test pass?         it "returs CORS headers" $ do           resp  <- testSnaplet sInit (mkRequest method "/noContent" "" [("Origin", "http://example.com")] "")           shouldHaveHeaders resp  [("access-control-allow-origin"@@ -363,7 +362,7 @@   describe "Servant.API.QueryParam" $ do        let runTest :: B8.ByteString -> B8.ByteString -> IO (Either T.Text Response)-          runTest p qs = runReqOnApi queryParamApi EmptyContext qpServer SC.GET p qs [(hContentType,"application/json;charset=utf-8")] ""+          runTest p qs = runReqOnApi queryParamApi EmptyContext qpServer SC.GET p qs [(hContentType,"application/json")] ""        it "allows retrieving simple GET parameters" $         runTest "" "?name=bob" >>= (`shouldDecodeTo` alice {name="bob"})@@ -459,8 +458,7 @@   describe "Servant.API.ReqBody" $ do      let runTest m p ct bod = runReqOnApi reqBodyApi EmptyContext server m p "" [(hContentType,ct)] bod-        goodCT = "application/json;charset=utf-8"-                 -- "application/json"+        goodCT = "application/json"         badCT  = "application/nonsense"      it "passes the argument to the handler" $ do