servant-server 0.14.1 → 0.15
raw patch · 31 files changed
+539/−391 lines, 31 filesdep −semigroupsdep ~QuickCheckdep ~aesondep ~basesetup-changed
Dependencies removed: semigroups
Dependency ranges changed: QuickCheck, aeson, base, base-compat, bytestring, containers, directory, doctest, filepath, hspec, http-api-data, http-media, http-types, mtl, network, resourcet, servant, tagged, transformers, transformers-base, transformers-compat, wai, wai-app-static, wai-extra, warp
Files
- CHANGELOG.md +50/−0
- LICENSE +1/−1
- Setup.hs +33/−0
- Setup.lhs +0/−31
- example/greet.hs +3/−1
- include/overlapping-compat.h +0/−8
- servant-server.cabal +42/−50
- src/Servant.hs +5/−4
- src/Servant/Server.hs +13/−9
- src/Servant/Server/Experimental/Auth.hs +28/−24
- src/Servant/Server/Generic.hs +42/−0
- src/Servant/Server/Internal.hs +128/−115
- src/Servant/Server/Internal/BasicAuth.hs +22/−13
- src/Servant/Server/Internal/Context.hs +2/−5
- src/Servant/Server/Internal/Handler.hs +19/−11
- src/Servant/Server/Internal/Router.hs +12/−7
- src/Servant/Server/Internal/RoutingApplication.hs +19/−10
- src/Servant/Server/Internal/ServantErr.hs +8/−5
- src/Servant/Server/StaticFiles.hs +1/−10
- src/Servant/Utils/StaticFiles.hs +1/−1
- test/Servant/ArbitraryMonadServerSpec.hs +4/−3
- test/Servant/HoistSpec.hs +4/−3
- test/Servant/Server/ErrorSpec.hs +11/−7
- test/Servant/Server/Internal/ContextSpec.hs +6/−3
- test/Servant/Server/Internal/RoutingApplicationSpec.hs +28/−22
- test/Servant/Server/RouterSpec.hs +18/−11
- test/Servant/Server/StreamingSpec.hs +8/−7
- test/Servant/Server/UsingContextSpec.hs +4/−3
- test/Servant/Server/UsingContextSpec/TestCombinators.hs +9/−9
- test/Servant/ServerSpec.hs +13/−15
- test/doctests.hs +5/−3
CHANGELOG.md view
@@ -1,6 +1,56 @@ [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.15+----++- Streaming refactoring.+ [#991](https://github.com/haskell-servant/servant/pull/991)+ [#1076](https://github.com/haskell-servant/servant/pull/1076)+ [#1077](https://github.com/haskell-servant/servant/pull/1077)++ The streaming functionality (`Servant.API.Stream`) is refactored to use+ `servant`'s own `SourceIO` type (see `Servant.Types.SourceT` documentation),+ which replaces both `StreamGenerator` and `ResultStream` types.++ New conversion type-classes are `ToSourceIO` and `FromSourceIO`+ (replacing `ToStreamGenerator` and `BuildFromStream`).+ There are instances for *conduit*, *pipes* and *machines* in new packages:+ [servant-conduit](https://hackage.haskell.org/package/servant-conduit)+ [servant-pipes](https://hackage.haskell.org/package/servant-pipes) and+ [servant-machines](https://hackage.haskell.org/package/servant-machines)+ respectively.++ Writing new framing strategies is simpler. Check existing strategies for examples.++ This change shouldn't affect you, if you don't use streaming endpoints.++- Drop support for GHC older than 8.0+ [#1008](https://github.com/haskell-servant/servant/pull/1008)+ [#1009](https://github.com/haskell-servant/servant/pull/1009)++- *servant* NewlineFraming encodes newline after each element (i.e last)+ [#1079](https://github.com/haskell-servant/servant/pull/1079)+ [#1011](https://github.com/haskell-servant/servant/issues/1011)++- *servant* Add `lookupResponseHeader :: ... => Headers headers r -> ResponseHeader h a`+ [#1064](https://github.com/haskell-servant/servant/pull/1064)++- *servant-server* Add `MonadMask Handler`+ [#1068](https://github.com/haskell-servant/servant/pull/1068)++- *servant* Export `GetHeaders'`+ [#1052](https://github.com/haskell-servant/servant/pull/1052)++- *servant* Add `Bitraversable` and other `Bi-` instances for `:<|>`+ [#1032](https://github.com/haskell-servant/servant/pull/1032)++- *servant* Add `PutCreated` method type alias+ [#1024](https://github.com/haskell-servant/servant/pull/1024)++- *servant* Add `ToSourceIO (NonEmpty a)` instance+ [#988](https://github.com/haskell-servant/servant/pull/988)+ 0.14.1 ------
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2014-2016, Zalora South East Asia Pte Ltd, Servant Contributors+Copyright (c) 2014-2016, Zalora South East Asia Pte Ltd, 2016-2018 Servant Contributors All rights reserved.
+ Setup.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -Wall #-}+module Main (main) where++#ifndef MIN_VERSION_cabal_doctest+#define MIN_VERSION_cabal_doctest(x,y,z) 0+#endif++#if MIN_VERSION_cabal_doctest(1,0,0)++import Distribution.Extra.Doctest ( defaultMainWithDoctests )+main :: IO ()+main = defaultMainWithDoctests "doctests"++#else++#ifdef MIN_VERSION_Cabal+-- If the macro is defined, we have new cabal-install,+-- but for some reason we don't have cabal-doctest in package-db+--+-- Probably we are running cabal sdist, when otherwise using new-build+-- workflow+#warning You are configuring this package without cabal-doctest installed. \+ The doctests test-suite will not work as a result. \+ To fix this, install cabal-doctest before configuring.+#endif++import Distribution.Simple++main :: IO ()+main = defaultMain++#endif
− Setup.lhs
@@ -1,31 +0,0 @@-\begin{code}-{-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -Wall #-}-module Main (main) where--#ifndef MIN_VERSION_cabal_doctest-#define MIN_VERSION_cabal_doctest(x,y,z) 0-#endif--#if MIN_VERSION_cabal_doctest(1,0,0)--import Distribution.Extra.Doctest ( defaultMainWithDoctests )-main :: IO ()-main = defaultMainWithDoctests "doctests"--#else--#ifdef MIN_VERSION_Cabal-#warning You are configuring this package without cabal-doctest installed. \- The doctests test-suite will not work as a result. \- To fix this, install cabal-doctest before configuring.-#endif--import Distribution.Simple--main :: IO ()-main = defaultMain--#endif--\end{code}
example/greet.hs view
@@ -5,8 +5,10 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} +import Prelude ()+import Prelude.Compat+ import Data.Aeson-import Data.Monoid import Data.Proxy import Data.Text import GHC.Generics
− include/overlapping-compat.h
@@ -1,8 +0,0 @@-#if __GLASGOW_HASKELL__ >= 710-#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}-#define OVERLAPPING_ {-# OVERLAPPING #-}-#else-{-# LANGUAGE OverlappingInstances #-}-#define OVERLAPPABLE_-#define OVERLAPPING_-#endif
servant-server.cabal view
@@ -1,6 +1,9 @@+cabal-version: >=1.10 name: servant-server-version: 0.14.1+version: 0.15+ synopsis: A family of combinators for defining webservices APIs and serving them+category: Servant, Web description: A family of combinators for defining webservices APIs and serving them .@@ -11,24 +14,22 @@ a webserver that serves this API, using this package. . <https://github.com/haskell-servant/servant/blob/master/servant-server/CHANGELOG.md CHANGELOG>+ homepage: http://haskell-servant.readthedocs.org/-Bug-reports: http://github.com/haskell-servant/servant/issues+bug-reports: http://github.com/haskell-servant/servant/issues license: BSD3 license-file: LICENSE author: Servant Contributors maintainer: haskell-servant-maintainers@googlegroups.com-copyright: 2014-2016 Zalora South East Asia Pte Ltd, Servant Contributors-category: Servant, Web+copyright: 2014-2016 Zalora South East Asia Pte Ltd, 2016-2018 Servant Contributors 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.3+ GHC ==8.0.2+ || ==8.2.2+ || ==8.4.4+ || ==8.6.2+ extra-source-files:- include/*.h CHANGELOG.md README.md @@ -63,52 +64,43 @@ -- Bundled with GHC: Lower bound to not force re-installs -- text and mtl are bundled starting with GHC-8.4- --- -- note: mtl lower bound is so low because of GHC-7.8 build-depends:- base >= 4.7 && < 4.12- , bytestring >= 0.10.4.0 && < 0.11- , containers >= 0.5.5.1 && < 0.6- , mtl >= 2.1 && < 2.3- , text >= 1.2.3.0 && < 1.3- , transformers >= 0.3.0.0 && < 0.6- , filepath >= 1.3.0.2 && < 1.5-- if !impl(ghc >= 8.0)- build-depends:- semigroups >= 0.18.4 && < 0.19+ base >= 4.9 && < 4.13+ , bytestring >= 0.10.8.1 && < 0.11+ , containers >= 0.5.7.1 && < 0.7+ , mtl >= 2.2.2 && < 2.3+ , text >= 1.2.3.0 && < 1.3+ , transformers >= 0.5.2.0 && < 0.6+ , filepath >= 1.4.1.1 && < 1.5 -- Servant dependencies+ -- strict dependency as we re-export 'servant' things. build-depends:- servant >= 0.14.1 && <0.15+ servant >= 0.15 && < 0.15.1+ , http-api-data >= 0.4 && < 0.4.1 -- 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:- base-compat >= 0.10.1 && < 0.11+ base-compat >= 0.10.5 && < 0.11 , base64-bytestring >= 1.0.0.1 && < 1.1 , 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+ , http-media >= 0.7.1.3 && < 0.8+ , http-types >= 0.12.2 && < 0.13 , network-uri >= 2.6.1.0 && < 2.7 , monad-control >= 1.0.2.3 && < 1.1- , network >= 2.6.3.5 && < 2.8+ , network >= 2.8 && < 2.9 , string-conversions >= 0.4.0.1 && < 0.5- , resourcet >= 1.1.11 && < 1.3- , tagged >= 0.8.5 && < 0.9- , transformers-base >= 0.4.4 && < 0.5- , transformers-compat >= 0.6.2 && < 0.7- , wai >= 3.2.1.1 && < 3.3- , wai-app-static >= 3.1.6.1 && < 3.2+ , resourcet >= 1.2.2 && < 1.3+ , tagged >= 0.8.6 && < 0.9+ , transformers-base >= 0.4.5.2 && < 0.5+ , wai >= 3.2.1.2 && < 3.3+ , wai-app-static >= 3.1.6.2 && < 3.2 , word8 >= 0.1.3 && < 0.2 hs-source-dirs: src default-language: Haskell2010- ghc-options: -Wall- if impl(ghc >= 8.0)- ghc-options: -Wno-redundant-constraints- include-dirs: include+ ghc-options: -Wall -Wno-redundant-constraints executable greet main-is: greet.hs@@ -117,14 +109,15 @@ default-language: Haskell2010 build-depends: base+ , base-compat , servant , servant-server , wai , text build-depends:- aeson >= 1.3.1.1 && < 1.5- , warp >= 3.2.13 && < 3.3+ aeson >= 1.4.1.0 && < 1.5+ , warp >= 3.2.25 && < 3.3 test-suite spec type: exitcode-stdio-1.0@@ -165,23 +158,23 @@ -- Additonal dependencies build-depends:- aeson >= 1.3.1.1 && < 1.5- , directory >= 1.2.1.0 && < 1.4- , hspec >= 2.5.1 && < 2.6+ aeson >= 1.4.1.0 && < 1.5+ , directory >= 1.3.0.0 && < 1.4+ , hspec >= 2.6.0 && < 2.7 , hspec-wai >= 0.9.0 && < 0.10- , QuickCheck >= 2.11.3 && < 2.12+ , QuickCheck >= 2.12.6.1 && < 2.13 , should-not-typecheck >= 2.1.0 && < 2.2 , temporary >= 1.3 && < 1.4- , wai-extra >= 3.0.21.0 && < 3.1+ , wai-extra >= 3.0.24.3 && < 3.1 build-tool-depends:- hspec-discover:hspec-discover >= 2.5.1 && <2.6+ hspec-discover:hspec-discover >= 2.6.0 && <2.7 test-suite doctests build-depends: base , servant-server- , doctest >= 0.15.0 && <0.17+ , doctest >= 0.16.0 && <0.17 type: exitcode-stdio-1.0 main-is: test/doctests.hs buildable: True@@ -189,4 +182,3 @@ ghc-options: -Wall -threaded if impl(ghc >= 8.2) x-doctest-options: -fdiagnostics-color=never- include-dirs: include
src/Servant.hs view
@@ -7,15 +7,16 @@ module Servant.Server, -- | Utilities on top of the servant core module Servant.Links,- module Servant.Utils.StaticFiles,+ module Servant.Server.StaticFiles, -- | Useful re-exports Proxy(..), throwError ) where -import Control.Monad.Error.Class (throwError)+import Control.Monad.Error.Class+ (throwError) import Data.Proxy import Servant.API-import Servant.Server import Servant.Links-import Servant.Utils.StaticFiles+import Servant.Server+import Servant.Server.StaticFiles
src/Servant/Server.hs view
@@ -1,8 +1,8 @@-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-} -- | This module lets you implement 'Server's for defined APIs. You'll -- most likely just need 'serve'.@@ -92,10 +92,14 @@ ) where -import Data.Proxy (Proxy (..))-import Data.Tagged (Tagged (..))-import Data.Text (Text)-import Network.Wai (Application)+import Data.Proxy+ (Proxy (..))+import Data.Tagged+ (Tagged (..))+import Data.Text+ (Text)+import Network.Wai+ (Application) import Servant.Server.Internal
src/Servant/Server/Experimental/Auth.hs view
@@ -1,33 +1,37 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-} module Servant.Server.Experimental.Auth where -import Control.Monad.Trans (liftIO)-import Data.Proxy (Proxy (Proxy))-import Data.Typeable (Typeable)-import GHC.Generics (Generic)-import Network.Wai (Request)+import Control.Monad.Trans+ (liftIO)+import Data.Proxy+ (Proxy (Proxy))+import Data.Typeable+ (Typeable)+import GHC.Generics+ (Generic)+import Network.Wai+ (Request) -import Servant ((:>))+import Servant+ ((:>)) import Servant.API.Experimental.Auth-import Servant.Server.Internal (HasContextEntry,- HasServer (..),- getContextEntry)-import Servant.Server.Internal.RoutingApplication (addAuthCheck,- delayedFailFatal,- DelayedIO,- withRequest)-import Servant.Server.Internal.Handler (Handler, runHandler)+import Servant.Server.Internal+ (HasContextEntry, HasServer (..), getContextEntry)+import Servant.Server.Internal.Handler+ (Handler, runHandler)+import Servant.Server.Internal.RoutingApplication+ (DelayedIO, addAuthCheck, delayedFailFatal, withRequest) -- * General Auth
src/Servant/Server/Generic.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE KindSignatures #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}@@ -11,6 +12,8 @@ AsServerT, AsServer, genericServe,+ genericServeT,+ genericServeTWithContext, genericServer, genericServerT, ) where@@ -37,6 +40,45 @@ ) => routes AsServer -> Application genericServe = serve (Proxy :: Proxy (ToServantApi routes)) . genericServer++-- | Transform a record of routes with custom monad into a WAI 'Application',+-- by providing a transformation to bring each handler back in the 'Handler'+-- monad.+genericServeT+ :: forall (routes :: * -> *) (m :: * -> *).+ ( GenericServant routes (AsServerT m)+ , GenericServant routes AsApi+ , HasServer (ToServantApi routes) '[]+ , ServerT (ToServantApi routes) m ~ ToServant routes (AsServerT m)+ )+ => (forall a. m a -> Handler a) -- ^ 'hoistServer' argument to come back to 'Handler'+ -> routes (AsServerT m) -- ^ your record full of request handlers+ -> Application+genericServeT f server = serve p $ hoistServer p f (genericServerT server)+ where+ p = genericApi (Proxy :: Proxy routes)++-- | Transform a record of routes with custom monad into a WAI 'Application',+-- while using the given 'Context' to serve the application (contexts are typically+-- used by auth-related combinators in servant, e.g to hold auth checks) and the given+-- transformation to map all the handlers back to the 'Handler' monad.+genericServeTWithContext+ :: forall (routes :: * -> *) (m :: * -> *) (ctx :: [*]).+ ( GenericServant routes (AsServerT m)+ , GenericServant routes AsApi+ , HasServer (ToServantApi routes) ctx+ , ServerT (ToServantApi routes) m ~ ToServant routes (AsServerT m)+ )+ => (forall a. m a -> Handler a) -- ^ 'hoistServer' argument to come back to 'Handler'+ -> routes (AsServerT m) -- ^ your record full of request handlers+ -> Context ctx -- ^ the 'Context' to serve the application with+ -> Application+genericServeTWithContext f server ctx =+ serveWithContext p ctx $+ hoistServerWithContext p pctx f (genericServerT server)+ where+ p = genericApi (Proxy :: Proxy routes)+ pctx = Proxy :: Proxy ctx -- | Transform record of endpoints into a 'Server'. genericServer
src/Servant/Server/Internal.hs view
@@ -1,29 +1,23 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-} #if MIN_VERSION_base(4,9,0) && __GLASGOW_HASKELL__ >= 802 #define HAS_TYPE_ERROR #endif -#ifdef HAS_TYPE_ERROR-{-# LANGUAGE UndecidableInstances #-}-#endif--#include "overlapping-compat.h"- module Servant.Server.Internal ( module Servant.Server.Internal , module Servant.Server.Internal.BasicAuth@@ -34,72 +28,74 @@ , module Servant.Server.Internal.ServantErr ) where -import Control.Monad (join, when)-import Control.Monad.Trans (liftIO)-import Control.Monad.Trans.Resource (runResourceT)-import qualified Data.ByteString as B-import qualified Data.ByteString.Builder as BB-import qualified Data.ByteString.Char8 as BC8-import qualified Data.ByteString.Lazy as BL-import Data.Maybe (fromMaybe, mapMaybe,- isNothing, maybeToList)-import Data.Either (partitionEithers)-import Data.Semigroup ((<>))-import Data.String (IsString (..))-import Data.String.Conversions (cs)-import Data.Tagged (Tagged(..), retag, untag)-import qualified Data.Text as T+import Control.Monad+ (join, when)+import Control.Monad.Trans+ (liftIO)+import Control.Monad.Trans.Resource+ (runResourceT)+import qualified Data.ByteString as B+import qualified Data.ByteString.Builder as BB+import qualified Data.ByteString.Char8 as BC8+import qualified Data.ByteString.Lazy as BL+import Data.Either+ (partitionEithers)+import Data.Maybe+ (fromMaybe, isNothing, mapMaybe, maybeToList)+import Data.Semigroup+ ((<>))+import Data.String+ (IsString (..))+import Data.String.Conversions+ (cs)+import Data.Tagged+ (Tagged (..), retag, untag)+import qualified Data.Text as T import Data.Typeable-import GHC.TypeLits (KnownNat, KnownSymbol, natVal,- symbolVal)-import Network.HTTP.Types hiding (Header, ResponseHeaders)-import qualified Network.HTTP.Media as NHM-import Network.Socket (SockAddr)-import Network.Wai (Application, Request,- httpVersion, isSecure,- lazyRequestBody,- rawQueryString, remoteHost,- requestHeaders, requestMethod,- responseLBS, responseStream,- vault)-import Prelude ()+import GHC.TypeLits+ (KnownNat, KnownSymbol, natVal, symbolVal)+import qualified Network.HTTP.Media as NHM+import Network.HTTP.Types hiding+ (Header, ResponseHeaders)+import Network.Socket+ (SockAddr)+import Network.Wai+ (Application, Request, httpVersion, isSecure, lazyRequestBody,+ rawQueryString, remoteHost, requestBody, requestHeaders,+ requestMethod, responseLBS, responseStream, vault)+import Prelude () import Prelude.Compat-import Web.HttpApiData (FromHttpApiData, parseHeader,- parseQueryParam,- parseUrlPieceMaybe,- parseUrlPieces)-import Servant.API ((:<|>) (..), (:>), BasicAuth, Capture',- CaptureAll, Verb, EmptyAPI,- ReflectMethod(reflectMethod),- IsSecure(..), Header', QueryFlag,- QueryParam', QueryParams, Raw,- RemoteHost, ReqBody', Vault,- WithNamedContext,- Description, Summary,- Accept(..),- FramingRender(..), Stream,- StreamGenerator(..), ToStreamGenerator(..),- BoundaryStrategy(..),- If, SBool (..), SBoolI (..))-import Servant.API.Modifiers (unfoldRequestArgument, RequestArgument, FoldRequired, FoldLenient)-import Servant.API.ContentTypes (AcceptHeader (..),- AllCTRender (..),- AllCTUnrender (..),- AllMime,- MimeRender(..),- canHandleAcceptH)-import Servant.API.ResponseHeaders (GetHeaders, Headers, getHeaders,- getResponse)+import Servant.API+ ((:<|>) (..), (:>), Accept (..), BasicAuth, Capture',+ CaptureAll, Description, EmptyAPI, FramingRender (..),+ FramingUnrender (..), FromSourceIO (..), Header', If,+ IsSecure (..), QueryFlag, QueryParam', QueryParams, Raw,+ ReflectMethod (reflectMethod), RemoteHost, ReqBody',+ SBool (..), SBoolI (..), SourceIO, Stream, StreamBody',+ Summary, ToSourceIO (..), Vault, Verb, WithNamedContext)+import Servant.API.ContentTypes+ (AcceptHeader (..), AllCTRender (..), AllCTUnrender (..),+ AllMime, MimeRender (..), MimeUnrender (..), canHandleAcceptH)+import Servant.API.Modifiers+ (FoldLenient, FoldRequired, RequestArgument,+ unfoldRequestArgument)+import Servant.API.ResponseHeaders+ (GetHeaders, Headers, getHeaders, getResponse)+import qualified Servant.Types.SourceT as S+import Web.HttpApiData+ (FromHttpApiData, parseHeader, parseQueryParam,+ parseUrlPieceMaybe, parseUrlPieces) -import Servant.Server.Internal.Context import Servant.Server.Internal.BasicAuth+import Servant.Server.Internal.Context import Servant.Server.Internal.Handler import Servant.Server.Internal.Router import Servant.Server.Internal.RoutingApplication import Servant.Server.Internal.ServantErr #ifdef HAS_TYPE_ERROR-import GHC.TypeLits (TypeError, ErrorMessage (..))+import GHC.TypeLits+ (ErrorMessage (..), TypeError) #endif class HasServer api context where@@ -258,7 +254,7 @@ let bdy = if allowedMethodHead method request then "" else body in Route $ responseLBS status ((hContentType, cs contentT) : headers) bdy -instance OVERLAPPABLE_+instance {-# OVERLAPPABLE #-} ( AllCTRender ctypes a, ReflectMethod method, KnownNat status ) => HasServer (Verb method status ctypes a) context where @@ -269,7 +265,7 @@ where method = reflectMethod (Proxy :: Proxy method) status = toEnum . fromInteger $ natVal (Proxy :: Proxy status) -instance OVERLAPPING_+instance {-# OVERLAPPING #-} ( AllCTRender ctypes a, ReflectMethod method, KnownNat status , GetHeaders (Headers h a) ) => HasServer (Verb method status ctypes (Headers h a)) context where@@ -282,25 +278,26 @@ status = toEnum . fromInteger $ natVal (Proxy :: Proxy status) -instance OVERLAPPABLE_- ( MimeRender ctype a, ReflectMethod method, KnownNat status,- FramingRender framing ctype, ToStreamGenerator b a- ) => HasServer (Stream method status framing ctype b) context where+instance {-# OVERLAPPABLE #-}+ ( MimeRender ctype chunk, ReflectMethod method, KnownNat status,+ FramingRender framing, ToSourceIO chunk a+ ) => HasServer (Stream method status framing ctype a) context where - type ServerT (Stream method status framing ctype b) m = m b+ type ServerT (Stream method status framing ctype a) m = m a hoistServerWithContext _ _ nt s = nt s 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, 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 status framing ctype (Headers h b)) m = m (Headers h b)+instance {-# OVERLAPPING #-}+ ( MimeRender ctype chunk, ReflectMethod method, KnownNat status,+ FramingRender framing, ToSourceIO chunk a,+ GetHeaders (Headers h a)+ ) => HasServer (Stream method status framing ctype (Headers h a)) context where++ type ServerT (Stream method status framing ctype (Headers h a)) m = m (Headers h a) hoistServerWithContext _ _ nt s = nt s route Proxy _ = streamRouter (\x -> (getHeaders x, getResponse x)) method status (Proxy :: Proxy framing) (Proxy :: Proxy ctype)@@ -308,8 +305,8 @@ status = toEnum . fromInteger $ natVal (Proxy :: Proxy status) -streamRouter :: (MimeRender ctype a, FramingRender framing ctype, ToStreamGenerator b a) =>- (c -> ([(HeaderName, B.ByteString)], b))+streamRouter :: forall ctype a c chunk env framing. (MimeRender ctype chunk, FramingRender framing, ToSourceIO chunk a) =>+ (c -> ([(HeaderName, B.ByteString)], a)) -> Method -> Status -> Proxy framing@@ -325,29 +322,20 @@ `addAcceptCheck` accCheck ) env request respond $ \ output -> let (headers, fa) = splitHeaders output- k = getStreamGenerator . toStreamGenerator $ fa in- Route $ responseStream status (contentHeader : headers) $ \write flush -> do- write . BB.lazyByteString $ header framingproxy ctypeproxy- case boundary framingproxy ctypeproxy of- BoundaryStrategyBracket f ->- let go x = let bs = mimeRender ctypeproxy x- (before, after) = f bs- in write ( BB.lazyByteString before- <> BB.lazyByteString bs- <> BB.lazyByteString after) >> flush- in k go go- BoundaryStrategyIntersperse sep -> k- (\x -> do- write . BB.lazyByteString . mimeRender ctypeproxy $ x- flush)- (\x -> do- write . (BB.lazyByteString sep <>) . BB.lazyByteString . mimeRender ctypeproxy $ x- flush)- BoundaryStrategyGeneral f ->- let go = (>> flush) . write . BB.lazyByteString . f . mimeRender ctypeproxy- in k go go- write . BB.lazyByteString $ trailer framingproxy ctypeproxy+ sourceT = toSourceIO fa+ S.SourceT kStepLBS = framingRender framingproxy (mimeRender ctypeproxy :: chunk -> BL.ByteString) sourceT+ in Route $ responseStream status (contentHeader : headers) $ \write flush -> do+ let loop S.Stop = flush+ loop (S.Error err) = fail err -- TODO: throw better error+ loop (S.Skip s) = loop s+ loop (S.Effect ms) = ms >>= loop+ loop (S.Yield lbs s) = do+ write (BB.lazyByteString lbs)+ flush+ loop s + kStepLBS loop+ -- | If you use 'Header' in one of the endpoints for your API, -- this automatically requires your server-side handler to be a function -- that takes an argument of the type specified by 'Header'.@@ -619,6 +607,31 @@ Left e -> delayedFailFatal err400 { errBody = cs e } Right v -> return v +instance+ ( FramingUnrender framing, FromSourceIO chunk a, MimeUnrender ctype chunk+ , HasServer api context+ ) => HasServer (StreamBody' mods framing ctype a :> api) context+ where+ type ServerT (StreamBody' mods framing ctype a :> api) m = a -> ServerT api m++ hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s++ route Proxy context subserver = route (Proxy :: Proxy api) context $+ addBodyCheck subserver ctCheck bodyCheck+ where+ ctCheck :: DelayedIO (SourceIO chunk -> a)+ -- TODO: do content-type check+ ctCheck = return fromSourceIO++ bodyCheck :: (SourceIO chunk -> a) -> DelayedIO a+ bodyCheck fromRS = withRequest $ \req -> do+ let mimeUnrender' = mimeUnrender (Proxy :: Proxy ctype) :: BL.ByteString -> Either String chunk+ let framingUnrender' = framingUnrender (Proxy :: Proxy framing) mimeUnrender' :: SourceIO B.ByteString -> SourceIO chunk+ let body = requestBody req+ let rs = S.fromAction B.null body+ let rs' = fromRS $ framingUnrender' rs+ return rs'+ -- | Make sure the incoming request starts with @"/path"@, strip it and -- pass the rest of the request path to @api@. instance (KnownSymbol path, HasServer api context) => HasServer (path :> api) context where@@ -762,7 +775,7 @@ -- ...Maybe you haven't applied enough arguments to -- ...Capture' '[] "foo" -- ...--- +-- instance TypeError (HasServerArrowKindError arr) => HasServer ((arr :: k -> l) :> api) context where type ServerT (arr :> api) m = TypeError (HasServerArrowKindError arr)
src/Servant/Server/Internal/BasicAuth.hs view
@@ -1,22 +1,31 @@ {-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-} module Servant.Server.Internal.BasicAuth where -import Control.Monad (guard)-import Control.Monad.Trans (liftIO)-import qualified Data.ByteString as BS-import Data.ByteString.Base64 (decodeLenient)-import Data.Monoid ((<>))-import Data.Typeable (Typeable)-import Data.Word8 (isSpace, toLower, _colon)+import Control.Monad+ (guard)+import Control.Monad.Trans+ (liftIO)+import qualified Data.ByteString as BS+import Data.ByteString.Base64+ (decodeLenient)+import Data.Monoid+ ((<>))+import Data.Typeable+ (Typeable)+import Data.Word8+ (isSpace, toLower, _colon) import GHC.Generics-import Network.HTTP.Types (Header)-import Network.Wai (Request, requestHeaders)+import Network.HTTP.Types+ (Header)+import Network.Wai+ (Request, requestHeaders) -import Servant.API.BasicAuth (BasicAuthData(BasicAuthData))+import Servant.API.BasicAuth+ (BasicAuthData (BasicAuthData)) import Servant.Server.Internal.RoutingApplication import Servant.Server.Internal.ServantErr
src/Servant/Server/Internal/Context.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}@@ -8,8 +7,6 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} -#include "overlapping-compat.h"- module Servant.Server.Internal.Context where import Data.Proxy@@ -64,11 +61,11 @@ class HasContextEntry (context :: [*]) (val :: *) where getContextEntry :: Context context -> val -instance OVERLAPPABLE_+instance {-# OVERLAPPABLE #-} HasContextEntry xs val => HasContextEntry (notIt ': xs) val where getContextEntry (_ :. xs) = getContextEntry xs -instance OVERLAPPING_+instance {-# OVERLAPPING #-} HasContextEntry (val ': xs) val where getContextEntry (x :. _) = x
src/Servant/Server/Internal/Handler.hs view
@@ -5,23 +5,31 @@ {-# LANGUAGE TypeFamilies #-} module Servant.Server.Internal.Handler where -import Prelude ()-import Prelude.Compat+import Prelude ()+import Prelude.Compat -import Control.Monad.Base (MonadBase (..))-import Control.Monad.Catch (MonadCatch, MonadThrow)-import Control.Monad.Error.Class (MonadError)-import Control.Monad.IO.Class (MonadIO)-import Control.Monad.Trans.Control (MonadBaseControl (..))-import Control.Monad.Trans.Except (ExceptT, runExceptT)-import GHC.Generics (Generic)-import Servant.Server.Internal.ServantErr (ServantErr)+import Control.Monad.Base+ (MonadBase (..))+import Control.Monad.Catch+ (MonadCatch, MonadMask, MonadThrow)+import Control.Monad.Error.Class+ (MonadError)+import Control.Monad.IO.Class+ (MonadIO)+import Control.Monad.Trans.Control+ (MonadBaseControl (..))+import Control.Monad.Trans.Except+ (ExceptT, runExceptT)+import GHC.Generics+ (Generic)+import Servant.Server.Internal.ServantErr+ (ServantErr) newtype Handler a = Handler { runHandler' :: ExceptT ServantErr IO a } deriving ( Functor, Applicative, Monad, MonadIO, Generic , MonadError ServantErr- , MonadThrow, MonadCatch+ , MonadThrow, MonadCatch, MonadMask ) instance MonadBase IO Handler where
src/Servant/Server/Internal/Router.hs view
@@ -1,15 +1,20 @@-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE GADTs #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} module Servant.Server.Internal.Router where -import Data.Map (Map)+import Prelude ()+import Prelude.Compat++import Data.Map+ (Map) import qualified Data.Map as M-import Data.Monoid-import Data.Text (Text)+import Data.Text+ (Text) import qualified Data.Text as T-import Network.Wai (Response, pathInfo)+import Network.Wai+ (Response, pathInfo) import Servant.Server.Internal.RoutingApplication import Servant.Server.Internal.ServantErr
src/Servant/Server/Internal/RoutingApplication.hs view
@@ -10,16 +10,25 @@ {-# LANGUAGE UndecidableInstances #-} module Servant.Server.Internal.RoutingApplication where -import Control.Monad (ap, liftM)-import Control.Monad.Base (MonadBase (..))-import Control.Monad.Catch (MonadThrow (..))-import Control.Monad.Reader (MonadReader (..), ReaderT (..), runReaderT)-import Control.Monad.Trans (MonadIO (..), MonadTrans (..))-import Control.Monad.Trans.Control (ComposeSt, MonadBaseControl (..), MonadTransControl (..),- defaultLiftBaseWith, defaultRestoreM)-import Control.Monad.Trans.Resource (MonadResource (..), ResourceT, runResourceT, transResourceT, withInternalState, runInternalState)-import Network.Wai (Application, Request, Response, ResponseReceived)-import Prelude ()+import Control.Monad+ (ap, liftM)+import Control.Monad.Base+ (MonadBase (..))+import Control.Monad.Catch+ (MonadThrow (..))+import Control.Monad.Reader+ (MonadReader (..), ReaderT (..), runReaderT)+import Control.Monad.Trans+ (MonadIO (..), MonadTrans (..))+import Control.Monad.Trans.Control+ (ComposeSt, MonadBaseControl (..), MonadTransControl (..),+ defaultLiftBaseWith, defaultRestoreM)+import Control.Monad.Trans.Resource+ (MonadResource (..), ResourceT, runInternalState,+ runResourceT, transResourceT, withInternalState)+import Network.Wai+ (Application, Request, Response, ResponseReceived)+import Prelude () import Prelude.Compat import Servant.Server.Internal.Handler import Servant.Server.Internal.ServantErr
src/Servant/Server/Internal/ServantErr.hs view
@@ -1,14 +1,17 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-} module Servant.Server.Internal.ServantErr where -import Control.Exception (Exception)+import Control.Exception+ (Exception) import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy as LBS-import Data.Typeable (Typeable)+import Data.Typeable+ (Typeable) import qualified Network.HTTP.Types as HTTP-import Network.Wai (Response, responseLBS)+import Network.Wai+ (Response, responseLBS) data ServantErr = ServantErr { errHTTPCode :: Int , errReasonPhrase :: String
src/Servant/Server/StaticFiles.hs view
@@ -24,10 +24,6 @@ (ServerT, Tagged (..)) import System.FilePath (addTrailingPathSeparator)-#if !MIN_VERSION_wai_app_static(3,1,0)-import Filesystem.Path.CurrentOS- (decodeString)-#endif import WaiAppStatic.Storage.Filesystem (ETagLookup) @@ -84,9 +80,4 @@ {-# DEPRECATED serveDirectory "Use serveDirectoryFileServer instead" #-} fixPath :: FilePath -> FilePath-fixPath =-#if MIN_VERSION_wai_app_static(3,1,0)- addTrailingPathSeparator-#else- decodeString . addTrailingPathSeparator-#endif+fixPath = addTrailingPathSeparator
src/Servant/Utils/StaticFiles.hs view
@@ -1,5 +1,5 @@ module Servant.Utils.StaticFiles- {-# DEPRECATED "Use Servant.ServerStaticFiles." #-}+ {-# DEPRECATED "Use Servant.Server.StaticFiles." #-} ( module Servant.Server.StaticFiles ) where
test/Servant/ArbitraryMonadServerSpec.hs view
@@ -9,9 +9,10 @@ import Servant.API import Servant.Server -import Test.Hspec (Spec, describe, it)-import Test.Hspec.Wai (get, matchStatus, post,- shouldRespondWith, with)+import Test.Hspec+ (Spec, describe, it)+import Test.Hspec.Wai+ (get, matchStatus, post, shouldRespondWith, with) spec :: Spec spec = describe "Arbitrary monad server" $ do
test/Servant/HoistSpec.hs view
@@ -1,10 +1,11 @@-{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeOperators #-} module Servant.HoistSpec where -import Test.Hspec (Spec)+import Test.Hspec+ (Spec) -import Servant+import Servant ------------------------------------------------------------------------------- -- https://github.com/haskell-servant/servant/issues/734
test/Servant/Server/ErrorSpec.hs view
@@ -6,16 +6,20 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Servant.Server.ErrorSpec (spec) where -import Control.Monad (when)-import Data.Aeson (encode)+import Control.Monad+ (when)+import Data.Aeson+ (encode) import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Lazy.Char8 as BCL-import Data.Monoid ((<>))+import Data.Monoid+ ((<>)) import Data.Proxy-import Network.HTTP.Types (hAccept, hAuthorization,- hContentType, methodGet,- methodPost, methodPut)-import Safe (readMay)+import Network.HTTP.Types+ (hAccept, hAuthorization, hContentType, methodGet, methodPost,+ methodPut)+import Safe+ (readMay) import Test.Hspec import Test.Hspec.Wai
test/Servant/Server/Internal/ContextSpec.hs view
@@ -2,9 +2,12 @@ {-# OPTIONS_GHC -fdefer-type-errors -Wwarn #-} module Servant.Server.Internal.ContextSpec (spec) where -import Data.Proxy (Proxy (..))-import Test.Hspec (Spec, describe, it, shouldBe, context)-import Test.ShouldNotTypecheck (shouldNotTypecheck)+import Data.Proxy+ (Proxy (..))+import Test.Hspec+ (Spec, context, describe, it, shouldBe)+import Test.ShouldNotTypecheck+ (shouldNotTypecheck) import Servant.API import Servant.Server.Internal.Context
test/Servant/Server/Internal/RoutingApplicationSpec.hs view
@@ -1,31 +1,37 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} module Servant.Server.Internal.RoutingApplicationSpec (spec) where -import Prelude ()-import Prelude.Compat+import Prelude ()+import Prelude.Compat -import Control.Exception hiding (Handler)-import Control.Monad.Trans.Resource (register)-import Control.Monad.IO.Class-import Data.IORef-import Data.Proxy-import GHC.TypeLits (Symbol, KnownSymbol, symbolVal)-import Servant-import Servant.Server.Internal.RoutingApplication-import Network.Wai (defaultRequest)-import Test.Hspec-import Test.Hspec.Wai (request, shouldRespondWith, with)+import Control.Exception hiding+ (Handler)+import Control.Monad.IO.Class+import Control.Monad.Trans.Resource+ (register)+import Data.IORef+import Data.Proxy+import GHC.TypeLits+ (KnownSymbol, Symbol, symbolVal)+import Network.Wai+ (defaultRequest)+import Servant+import Servant.Server.Internal.RoutingApplication+import Test.Hspec+import Test.Hspec.Wai+ (request, shouldRespondWith, with) -import qualified Data.Text as T+import qualified Data.Text as T -import System.IO.Unsafe (unsafePerformIO)+import System.IO.Unsafe+ (unsafePerformIO) data TestResource x = TestResourceNone
test/Servant/Server/RouterSpec.hs view
@@ -1,20 +1,27 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeOperators #-} module Servant.Server.RouterSpec (spec) where -import Control.Monad (unless)-import Data.Proxy (Proxy(..))-import Data.Text (unpack)-import Network.HTTP.Types (Status (..))-import Network.Wai (responseBuilder)-import Network.Wai.Internal (Response (ResponseBuilder))-import Test.Hspec-import Test.Hspec.Wai (get, shouldRespondWith, with)+import Control.Monad+ (unless)+import Data.Proxy+ (Proxy (..))+import Data.Text+ (unpack)+import Network.HTTP.Types+ (Status (..))+import Network.Wai+ (responseBuilder)+import Network.Wai.Internal+ (Response (ResponseBuilder)) import Servant.API import Servant.Server import Servant.Server.Internal+import Test.Hspec+import Test.Hspec.Wai+ (get, shouldRespondWith, with) spec :: Spec spec = describe "Servant.Server.Internal.Router" $ do
test/Servant/Server/StreamingSpec.hs view
@@ -1,18 +1,19 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeOperators #-} -- | This module tests whether streaming works from client to server -- with a server implemented with servant-server. module Servant.Server.StreamingSpec where import Control.Concurrent-import Control.Exception hiding (Handler)+import Control.Exception hiding+ (Handler) import Control.Monad.IO.Class-import qualified Data.ByteString as Strict-import qualified Data.ByteString.Lazy as Lazy+import qualified Data.ByteString as Strict+import qualified Data.ByteString.Lazy as Lazy import Network.HTTP.Types import Network.Wai import Network.Wai.Internal
test/Servant/Server/UsingContextSpec.hs view
@@ -1,12 +1,13 @@-{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeOperators #-} module Servant.Server.UsingContextSpec where import Network.Wai-import Test.Hspec (Spec, describe, it)+import Test.Hspec+ (Spec, describe, it) import Test.Hspec.Wai import Servant
test/Servant/Server/UsingContextSpec/TestCombinators.hs view
@@ -1,13 +1,13 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-} -- | These are custom combinators for Servant.Server.UsingContextSpec. --
test/Servant/ServerSpec.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-}@@ -9,32 +8,30 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-}-#if __GLASGOW_HASKELL__ >= 800 {-# OPTIONS_GHC -freduction-depth=100 #-}-#else-{-# OPTIONS_GHC -fcontext-stack=100 #-}-#endif module Servant.ServerSpec where +import Prelude ()+import Prelude.Compat+ 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 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 qualified Data.Text as T import GHC.Generics (Generic) import Network.HTTP.Types@@ -53,18 +50,19 @@ 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+ RemoteHost, ReqBody, SourceIO, StdMethod (..), Stream, Verb,+ addHeader) import Servant.Server (Context ((:.), EmptyContext), Handler, Server, Tagged (..), emptyServer, err401, err403, err404, serve, serveWithContext)+import Servant.Test.ComprehensiveAPI+import qualified Servant.Types.SourceT as S 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 qualified Test.Hspec.Wai as THW import Servant.Server.Experimental.Auth (AuthHandler, AuthServerData, mkAuthHandler)@@ -111,7 +109,7 @@ :<|> "accept" :> ( Verb method status '[JSON] Person :<|> Verb method status '[PlainText] String )- :<|> "stream" :> Stream method status NoFraming OctetStream (StreamGenerator BS.ByteString)+ :<|> "stream" :> Stream method status NoFraming OctetStream (SourceIO BS.ByteString) verbSpec :: Spec verbSpec = describe "Servant.API.Verb" $ do@@ -121,7 +119,7 @@ :<|> return (addHeader 5 alice) :<|> return (addHeader 10 NoContent) :<|> (return alice :<|> return "B")- :<|> return (StreamGenerator $ \f _ -> f "bytestring")+ :<|> return (S.source ["bytestring"]) get200 = Proxy :: Proxy (VerbApi 'GET 200) post210 = Proxy :: Proxy (VerbApi 'POST 210)
test/doctests.hs view
@@ -13,9 +13,11 @@ ----------------------------------------------------------------------------- module Main where -import Build_doctests (flags, pkgs, module_sources)-import Data.Foldable (traverse_)-import Test.DocTest+import Build_doctests+ (flags, module_sources, pkgs)+import Data.Foldable+ (traverse_)+import Test.DocTest main :: IO () main = do