Merge remote-tracking branch 'origin' into tutorial

.ghci

@@ -1 +0,0 @@
-:set -itest -isrc -packagehspec2

servant-client/CHANGELOG.md

@@ -6,7 +6,7 @@ HEAD
 * Added support for `path` on `BaseUrl`.
 * `client` now takes an explicit `Manager` argument.
 * Use `http-api-data` instead of `Servant.Common.Text`
-* Client functions now consider any 2xx succesful.
+* Client functions now consider any 2xx successful.
 * Remove matrix params.
 
 0.4.1

servant-client/test/Servant/ClientSpec.hs

@@ -115,7 +115,7 @@ api :: Proxy Api
 api = Proxy
 
 server :: Application
-server = serve api EmptyConfig (
+server = serve api (
        return alice
   :<|> return NoContent
   :<|> (\ name -> return $ Person name 0)
@@ -142,7 +142,7 @@ failApi :: Proxy FailApi
 failApi = Proxy
 
 failServer :: Application
-failServer = serve failApi EmptyConfig (
+failServer = serve failApi (
        (\ _request respond -> respond $ responseLBS ok200 [] "")
   :<|> (\ _capture _request respond -> respond $ responseLBS ok200 [("content-type", "application/json")] "")
   :<|> (\_request respond -> respond $ responseLBS ok200 [("content-type", "fooooo")] "")
@@ -232,7 +232,7 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
 
 wrappedApiSpec :: Spec
 wrappedApiSpec = describe "error status codes" $ do
-  let serveW api = serve api EmptyConfig $ throwE $ ServantErr 500 "error message" "" []
+  let serveW api = serve api $ throwE $ ServantErr 500 "error message" "" []
   context "are correctly handled by the client" $
     let test :: (WrappedApi, String) -> Spec
         test (WrappedApi api, desc) =

servant-foreign/CHANGELOG.md

@@ -2,3 +2,4 @@ HEAD
 -----
 * Use the `text` package instead of `String`.
 * Extract javascript-oblivious types and helpers to *servant-foreign*
+* Typed-languages support

servant-foreign/src/Servant/Foreign.hs

@@ -1,36 +1,50 @@
 -- | Generalizes all the data needed to make code generation work with
 -- arbitrary programming languages.
 module Servant.Foreign
-  ( HasForeign(..)
+  ( ArgType(..)
-  , HasForeignType(..)
+  , HeaderArg(..)
+  , QueryArg(..)
+  , Req(..)
   , Segment(..)
   , SegmentType(..)
+  , Url(..)
+    -- aliases
+  , Path
+  , ForeignType
+  , Arg
   , FunctionName
-  , QueryArg(..)
+    -- lenses
-  , HeaderArg(..)
+  , reqUrl
-  , ArgType(..)
+  , reqMethod
-  , Req
+  , reqHeaders
+  , reqBody
+  , reqReturnType
+  , reqFuncName
+  , path
+  , queryStr
+  , argName
+  , argType
+    -- prisms
+  , _HeaderArg
+  , _ReplaceHeaderArg
+  , _Static
+  , _Cap
+  , _Normal
+  , _Flag
+  , _List
+    -- rest of it
+  , HasForeign(..)
+  , HasForeignType(..)
+  , HasNoForeignType
+  , GenerateList(..)
+  , NoTypes
   , captureArg
-  , defReq
+  , isCapture
   , concatCase
   , snakeCase
   , camelCase
-  -- lenses
+  , defReq
-  , argType
-  , argName
-  , isCapture
-  , funcName
-  , path
-  , reqUrl
-  , reqBody
-  , reqHeaders
-  , reqMethod
-  , reqReturnType
-  , segment
-  , queryStr
   , listFromAPI
-  , GenerateList(..)
-  , NoTypes
   -- re-exports
   , module Servant.API
   ) where

servant-foreign/src/Servant/Foreign/Internal.hs

@@ -19,7 +19,7 @@
 -- arbitrary programming languages.
 module Servant.Foreign.Internal where
 
-import           Control.Lens          (makeLenses, (%~), (&), (.~), (<>~))
+import           Control.Lens (makeLenses, makePrisms, (%~), (&), (.~), (<>~))
 import qualified Data.Char as C
 import           Data.Proxy
 import           Data.Text
@@ -30,6 +30,8 @@ import qualified Network.HTTP.Types    as HTTP
 import           Prelude hiding (concat)
 import           Servant.API
 
+type FunctionName = [Text]
+
 -- | Function name builder that simply concat each part together
 concatCase :: FunctionName -> Text
 concatCase = concat
@@ -49,36 +51,50 @@ camelCase = camelCase' . Prelude.map (replace "-" "")
         capitalize name = C.toUpper (Data.Text.head name) `cons` Data.Text.tail name
 
 type ForeignType = Text
+
 type Arg = (Text, ForeignType)
 
-newtype Segment = Segment { _segment :: SegmentType  }
+data SegmentType
+  = Static Text
+    -- ^ a static path segment. like "/foo"
+  | Cap Arg
+    -- ^ a capture. like "/:userid"
   deriving (Eq, Show)
 
-data SegmentType = Static Text  -- ^ a static path segment. like "/foo"
+makePrisms ''SegmentType
-                 | Cap Arg        -- ^ a capture. like "/:userid"
+
+newtype Segment = Segment { unSegment :: SegmentType  }
   deriving (Eq, Show)
 
+makePrisms ''Segment
+
 type Path = [Segment]
 
-data ArgType =
+data ArgType
-    Normal
+  = Normal
   | Flag
   | List
   deriving (Eq, Show)
 
+makePrisms ''ArgType
+
 data QueryArg = QueryArg
   { _argName :: Arg
   , _argType :: ArgType
   } deriving (Eq, Show)
 
+makeLenses ''QueryArg
+
 data HeaderArg = HeaderArg
-    { headerArg :: Arg
+  { headerArg :: Arg }
-    }
   | ReplaceHeaderArg
   { headerArg :: Arg
   , headerPattern :: Text
   } deriving (Eq, Show)
 
+makeLenses ''HeaderArg
+
+makePrisms ''HeaderArg
 
 data Url = Url
   { _path     :: Path
@@ -88,7 +104,7 @@ data Url = Url
 defUrl :: Url
 defUrl = Url [] []
 
-type FunctionName = [Text]
+makeLenses ''Url
 
 data Req = Req
   { _reqUrl        :: Url
@@ -96,12 +112,9 @@ data Req = Req
   , _reqHeaders    :: [HeaderArg]
   , _reqBody       :: Maybe ForeignType
   , _reqReturnType :: ForeignType
-  , _funcName      :: FunctionName
+  , _reqFuncName   :: FunctionName
   } deriving (Eq, Show)
 
-makeLenses ''QueryArg
-makeLenses ''Segment
-makeLenses ''Url
 makeLenses ''Req
 
 isCapture :: Segment -> Bool
@@ -159,9 +172,11 @@ class HasForeignType lang a where
 
 data NoTypes
 
-instance HasForeignType NoTypes a where
+instance HasForeignType NoTypes ftype where
   typeFor _ _ = empty
 
+type HasNoForeignType = HasForeignType NoTypes
+
 class HasForeign lang (layout :: *) where
   type Foreign layout :: *
   foreignFor :: Proxy lang -> Proxy layout -> Req -> Foreign layout
@@ -174,25 +189,24 @@ instance (HasForeign lang a, HasForeign lang b)
          foreignFor lang (Proxy :: Proxy a) req
     :<|> foreignFor lang (Proxy :: Proxy b) req
 
-instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
+instance (KnownSymbol sym, HasForeignType lang ftype, HasForeign lang sublayout)
-      => HasForeign lang (Capture sym a :> sublayout) where
+  => HasForeign lang (Capture sym ftype :> sublayout) where
   type Foreign (Capture sym a :> sublayout) = Foreign sublayout
 
   foreignFor lang Proxy req =
     foreignFor lang (Proxy :: Proxy sublayout) $
       req & reqUrl.path <>~ [Segment (Cap arg)]
-          & funcName %~ (++ ["by", str])
+          & reqFuncName %~ (++ ["by", str])
-
     where
       str = pack . symbolVal $ (Proxy :: Proxy sym)
-    arg = (str, typeFor lang (Proxy :: Proxy a))
+      arg = (str, typeFor lang (Proxy :: Proxy ftype))
 
 instance (Elem JSON list, HasForeignType lang a, ReflectMethod method)
   => HasForeign lang (Verb method status list a) where
   type Foreign (Verb method status list a) = Req
 
   foreignFor lang Proxy req =
-    req & funcName  %~ (methodLC :)
+    req & reqFuncName  %~ (methodLC :)
         & reqMethod .~ method
         & reqReturnType .~ retType
     where
@@ -207,7 +221,6 @@ instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
   foreignFor lang Proxy req =
     foreignFor lang subP $ req
         & reqHeaders <>~ [HeaderArg arg]
-
     where
       hname = pack . symbolVal $ (Proxy :: Proxy sym)
       arg = (hname, typeFor lang (Proxy :: Proxy a))
@@ -225,35 +238,34 @@ instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
       str = pack . symbolVal $ (Proxy :: Proxy sym)
       arg = (str, typeFor lang (Proxy :: Proxy a))
 
-instance (KnownSymbol sym, HasForeignType lang [a], HasForeign lang sublayout)
+instance
+  (KnownSymbol sym, HasForeignType lang [a], HasForeign lang sublayout)
   => HasForeign lang (QueryParams sym a :> sublayout) where
   type Foreign (QueryParams sym a :> sublayout) = Foreign sublayout
-
   foreignFor lang Proxy req =
     foreignFor lang (Proxy :: Proxy sublayout) $
       req & reqUrl.queryStr <>~ [QueryArg arg List]
-
     where
       str = pack . symbolVal $ (Proxy :: Proxy sym)
       arg = (str, typeFor lang (Proxy :: Proxy [a]))
 
-instance (KnownSymbol sym, HasForeignType lang a, a ~ Bool, HasForeign lang sublayout)
+instance
+  (KnownSymbol sym, HasForeignType lang Bool, HasForeign lang sublayout)
   => HasForeign lang (QueryFlag sym :> sublayout) where
   type Foreign (QueryFlag sym :> sublayout) = Foreign sublayout
 
   foreignFor lang Proxy req =
     foreignFor lang (Proxy :: Proxy sublayout) $
       req & reqUrl.queryStr <>~ [QueryArg arg Flag]
-
     where
       str = pack . symbolVal $ (Proxy :: Proxy sym)
-    arg = (str, typeFor lang (Proxy :: Proxy a))
+      arg = (str, typeFor lang (Proxy :: Proxy Bool))
 
 instance HasForeign lang Raw where
   type Foreign Raw = HTTP.Method -> Req
 
   foreignFor _ Proxy req method =
-    req & funcName %~ ((toLower $ decodeUtf8 method) :)
+    req & reqFuncName %~ ((toLower $ decodeUtf8 method) :)
         & reqMethod .~ method
 
 instance (Elem JSON list, HasForeignType lang a, HasForeign lang sublayout)
@@ -271,19 +283,21 @@ instance (KnownSymbol path, HasForeign lang sublayout)
   foreignFor lang Proxy req =
     foreignFor lang (Proxy :: Proxy sublayout) $
       req & reqUrl.path <>~ [Segment (Static str)]
-          & funcName %~ (++ [str])
+          & reqFuncName %~ (++ [str])
-
     where
-    str = Data.Text.map (\c -> if c == '.' then '_' else c)
+      str =
+        Data.Text.map (\c -> if c == '.' then '_' else c)
           . pack . symbolVal $ (Proxy :: Proxy path)
 
-instance HasForeign lang sublayout => HasForeign lang (RemoteHost :> sublayout) where
+instance HasForeign lang sublayout
+  => HasForeign lang (RemoteHost :> sublayout) where
   type Foreign (RemoteHost :> sublayout) = Foreign sublayout
 
   foreignFor lang Proxy req =
     foreignFor lang (Proxy :: Proxy sublayout) req
 
-instance HasForeign lang sublayout => HasForeign lang (IsSecure :> sublayout) where
+instance HasForeign lang sublayout
+  => HasForeign lang (IsSecure :> sublayout) where
   type Foreign (IsSecure :> sublayout) = Foreign sublayout
 
   foreignFor lang Proxy req =
@@ -302,7 +316,8 @@ instance HasForeign lang sublayout =>
 
   foreignFor lang Proxy = foreignFor lang (Proxy :: Proxy sublayout)
 
-instance HasForeign lang sublayout => HasForeign lang (HttpVersion :> sublayout) where
+instance HasForeign lang sublayout
+  => HasForeign lang (HttpVersion :> sublayout) where
   type Foreign (HttpVersion :> sublayout) = Foreign sublayout
 
   foreignFor lang Proxy req =
@@ -317,10 +332,15 @@ class GenerateList reqs where
 instance GenerateList Req where
   generateList r = [r]
 
-instance (GenerateList start, GenerateList rest) => GenerateList (start :<|> rest) where
+instance (GenerateList start, GenerateList rest)
+  => GenerateList (start :<|> rest) where
   generateList (start :<|> rest) = (generateList start) ++ (generateList rest)
 
 -- | Generate the necessary data for codegen as a list, each 'Req'
 --   describing one endpoint from your API type.
-listFromAPI :: (HasForeign lang api, GenerateList (Foreign api)) => Proxy lang -> Proxy api -> [Req]
+listFromAPI
+  :: (HasForeign lang api, GenerateList (Foreign api))
+  => Proxy lang
+  -> Proxy api
+  -> [Req]
 listFromAPI lang p = generateList (foreignFor lang p defReq)

servant-foreign/test/Servant/ForeignSpec.hs

@@ -15,7 +15,6 @@ module Servant.ForeignSpec where
 import Data.Monoid ((<>))
 import Data.Proxy
 import Servant.Foreign
-import Servant.Foreign.Internal
 
 import Test.Hspec
 
@@ -36,12 +35,16 @@ data LangX
 
 instance HasForeignType LangX () where
   typeFor _ _ = "voidX"
+
 instance HasForeignType LangX Int where
   typeFor _ _ = "intX"
+
 instance HasForeignType LangX Bool where
   typeFor _ _ = "boolX"
+
 instance OVERLAPPING_ HasForeignType LangX String where
   typeFor _ _ = "stringX"
+
 instance OVERLAPPABLE_ HasForeignType LangX a => HasForeignType LangX [a] where
   typeFor lang _ = "listX of " <> typeFor lang (Proxy :: Proxy a)
 
@@ -70,7 +73,7 @@ listFromAPISpec = describe "listFromAPI" $ do
       , _reqHeaders    = [HeaderArg ("header", "listX of stringX")]
       , _reqBody       = Nothing
       , _reqReturnType = "intX"
-            , _funcName      = ["get", "test"]
+      , _reqFuncName      = ["get", "test"]
       }
 
   it "collects all info for post request" $ do
@@ -82,7 +85,7 @@ listFromAPISpec = describe "listFromAPI" $ do
       , _reqHeaders    = []
       , _reqBody       = Just "listX of stringX"
       , _reqReturnType = "voidX"
-            , _funcName      = ["post", "test"]
+      , _reqFuncName      = ["post", "test"]
       }
 
   it "collects all info for put request" $ do
@@ -95,7 +98,7 @@ listFromAPISpec = describe "listFromAPI" $ do
       , _reqHeaders    = []
       , _reqBody       = Just "stringX"
       , _reqReturnType = "voidX"
-            , _funcName      = ["put", "test"]
+      , _reqFuncName      = ["put", "test"]
       }
 
   it "collects all info for delete request" $ do
@@ -108,6 +111,5 @@ listFromAPISpec = describe "listFromAPI" $ do
       , _reqHeaders    = []
       , _reqBody       = Nothing
       , _reqReturnType = "voidX"
-            , _funcName      = ["delete", "test", "by", "id"]
+      , _reqFuncName      = ["delete", "test", "by", "id"]
       }
-

servant-js/src/Servant/JS/Angular.hs

@@ -128,7 +128,7 @@ generateAngularJSWith ngOptions opts req = "\n" <>
 
         fsep = if hasService then ":" else " ="
 
-        fname = namespace <> (functionNameBuilder opts $ req ^. funcName)
+        fname = namespace <> (functionNameBuilder opts $ req ^. reqFuncName)
 
         method = req ^. reqMethod
         url = if url' == "'" then "'/'" else url'

servant-js/src/Servant/JS/Axios.hs

@@ -116,7 +116,7 @@ generateAxiosJSWith aopts opts req = "\n" <>
                where
                   hasNoModule = moduleName opts == ""
 
-        fname = namespace <> (functionNameBuilder opts $ req ^. funcName)
+        fname = namespace <> (functionNameBuilder opts $ req ^. reqFuncName)
 
         method = T.toLower . decodeUtf8 $ req ^. reqMethod
         url = if url' == "'" then "'/'" else url'

servant-js/src/Servant/JS/Internal.hs

@@ -51,12 +51,19 @@ type JavaScriptGenerator = [Req] -> Text
 -- customize the output
 data CommonGeneratorOptions = CommonGeneratorOptions
   {
-    functionNameBuilder :: FunctionName -> Text  -- ^ function generating function names
+    functionNameBuilder :: FunctionName -> Text
-  , requestBody :: Text                -- ^ name used when a user want to send the request body (to let you redefine it)
+    -- ^ function generating function names
-  , successCallback :: Text            -- ^ name of the callback parameter when the request was successful
+  , requestBody :: Text
-  , errorCallback :: Text              -- ^ name of the callback parameter when the request reported an error
+    -- ^ name used when a user want to send the request body
-  , moduleName :: Text                 -- ^ namespace on which we define the foreign function (empty mean local var)
+    -- (to let you redefine it)
-  , urlPrefix :: Text                  -- ^ a prefix we should add to the Url in the codegen
+  , successCallback :: Text
+    -- ^ name of the callback parameter when the request was successful
+  , errorCallback :: Text
+    -- ^ name of the callback parameter when the request reported an error
+  , moduleName :: Text
+    -- ^ namespace on which we define the foreign function (empty mean local var)
+  , urlPrefix :: Text
+    -- ^ a prefix we should add to the Url in the codegen
   }
 
 -- | Default options.

servant-js/src/Servant/JS/JQuery.hs

@@ -81,7 +81,7 @@ generateJQueryJSWith opts req = "\n" <>
         namespace = if (moduleName opts) == ""
                        then "var "
                        else (moduleName opts) <> "."
-        fname = namespace <> (functionNameBuilder opts $ req ^. funcName)
+        fname = namespace <> (functionNameBuilder opts $ req ^. reqFuncName)
 
         method = req ^. reqMethod
         url = if url' == "'" then "'/'" else url'

servant-js/src/Servant/JS/Vanilla.hs

@@ -93,7 +93,7 @@ generateVanillaJSWith opts req = "\n" <>
         namespace = if moduleName opts == ""
                        then "var "
                        else (moduleName opts) <> "."
-        fname = namespace <> (functionNameBuilder opts $ req ^. funcName)
+        fname = namespace <> (functionNameBuilder opts $ req ^. reqFuncName)
 
         method = req ^. reqMethod
         url = if url' == "'" then "'/'" else url'

servant-mock/example/main.hs

@@ -20,4 +20,4 @@ api :: Proxy API
 api = Proxy
 
 main :: IO ()
-main = run 8080 (serve api EmptyConfig $ mock api Proxy)
+main = run 8080 (serve api $ mock api Proxy)

servant-mock/src/Servant/Mock.hs

@@ -67,7 +67,6 @@ import           Network.HTTP.Types.Status
 import           Network.Wai
 import           Servant
 import           Servant.API.ContentTypes
-import           Servant.Server.Internal.Config
 import           Test.QuickCheck.Arbitrary  (Arbitrary (..), vector)
 import           Test.QuickCheck.Gen        (Gen, generate)
 

servant-mock/test/Servant/MockSpec.hs

@@ -52,7 +52,7 @@ spec = do
     context "Get" $ do
       let api :: Proxy (Get '[JSON] Body)
           api = Proxy
-          app = serve api EmptyConfig (mock api Proxy)
+          app = serve api (mock api Proxy)
       with (return app) $ do
         it "serves arbitrary response bodies" $ do
           get "/" `shouldRespondWith` 200{
@@ -65,7 +65,7 @@ spec = do
           withoutHeader :: Proxy (Get '[JSON] (Headers '[] Body))
           withoutHeader = Proxy
           toApp :: (HasMock api '[]) => Proxy api -> IO Application
-          toApp api = return $ serve api EmptyConfig (mock api (Proxy :: Proxy '[]))
+          toApp api = return $ serve api (mock api (Proxy :: Proxy '[]))
       with (toApp withHeader) $ do
         it "serves arbitrary response bodies" $ do
           get "/" `shouldRespondWith` 200{

servant-server/example/greet.hs

@@ -59,7 +59,7 @@ server = helloH :<|> postGreetH :<|> deleteGreetH
 -- Turn the server into a WAI app. 'serve' is provided by servant,
 -- more precisely by the Servant.Server module.
 test :: Application
-test = serve testApi EmptyConfig server
+test = serve testApi server
 
 -- Run the server.
 --

servant-server/src/Servant/Server.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE ConstraintKinds   #-}
+{-# LANGUAGE DataKinds         #-}
 {-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeFamilies      #-}
@@ -8,6 +9,7 @@
 module Servant.Server
   ( -- * Run a wai application from an API
     serve
+  , serveWithConfig
 
   , -- * Construct a wai Application from an API
     toApplication
@@ -104,18 +106,18 @@ import           Servant.Server.Internal.Enter
 -- > myApi :: Proxy MyApi
 -- > myApi = Proxy
 -- >
--- > config :: Config '[]
--- > config = EmptyConfig
--- >
 -- > app :: Application
--- > app = serve myApi config server
+-- > app = serve myApi server
 -- >
 -- > main :: IO ()
 -- > main = Network.Wai.Handler.Warp.run 8080 app
 --
-serve :: (HasServer layout config)
+serve :: (HasServer layout '[]) => Proxy layout -> Server layout -> Application
+serve p = serveWithConfig p EmptyConfig
+
+serveWithConfig :: (HasServer layout config)
     => Proxy layout -> Config config -> Server layout -> Application
-serve p config server = toApplication (runRouter (route p config d))
+serveWithConfig p config server = toApplication (runRouter (route p config d))
   where
     d = Delayed r r r (\ _ _ -> Route server)
     r = return (Route ())

servant-server/src/Servant/Server/Internal.hs

@@ -158,7 +158,7 @@ methodCheck method request
 acceptCheck :: (AllMime list) => Proxy list -> B.ByteString -> IO (RouteResult ())
 acceptCheck proxy accH
   | canHandleAcceptH proxy (AcceptHeader accH) = return $ Route ()
-  | otherwise                                  = return $ Fail err406
+  | otherwise                                  = return $ FailFatal err406
 
 methodRouter :: (AllCTRender ctypes a)
              => Method -> Proxy ctypes -> Status

servant-server/src/Servant/Server/Internal/RoutingApplication.hs

@@ -11,14 +11,8 @@ module Servant.Server.Internal.RoutingApplication where
 import           Control.Applicative                ((<$>))
 #endif
 import           Control.Monad.Trans.Except         (ExceptT, runExceptT)
-import qualified Data.ByteString                    as B
-import qualified Data.ByteString.Lazy               as BL
-import           Data.IORef                         (newIORef, readIORef,
-                                                     writeIORef)
 import           Network.Wai                        (Application, Request,
-                                                     Response, ResponseReceived,
+                                                     Response, ResponseReceived)
-                                                     requestBody,
-                                                     strictRequestBody)
 import           Servant.Server.Internal.ServantErr
 
 type RoutingApplication =
@@ -33,34 +27,8 @@ data RouteResult a =
   | Route !a
   deriving (Eq, Show, Read, Functor)
 
-data ReqBodyState = Uncalled
-                  | Called !B.ByteString
-                  | Done !B.ByteString
-
 toApplication :: RoutingApplication -> Application
-toApplication ra request respond = do
+toApplication ra request respond = ra request routingRespond
-  reqBodyRef <- newIORef Uncalled
-  -- We may need to consume the requestBody more than once.  In order to
-  -- maintain the illusion that 'requestBody' works as expected,
-  -- 'ReqBodyState' is introduced, and the complete body is memoized and
-  -- returned as many times as requested with empty "Done" marker chunks in
-  -- between.
-  -- See https://github.com/haskell-servant/servant/issues/3
-  let memoReqBody = do
-          ior <- readIORef reqBodyRef
-          case ior of
-            Uncalled -> do
-                r <- BL.toStrict <$> strictRequestBody request
-                writeIORef reqBodyRef $ Done r
-                return r
-            Called bs -> do
-                writeIORef reqBodyRef $ Done bs
-                return bs
-            Done bs -> do
-                writeIORef reqBodyRef $ Called bs
-                return B.empty
-
-  ra request{ requestBody = memoReqBody } routingRespond
  where
   routingRespond :: RouteResult Response -> IO ResponseReceived
   routingRespond (Fail err)      = respond $ responseServantErr err
@@ -98,10 +66,10 @@ toApplication ra request respond = do
 --
 -- There are two reasons:
 --
--- 1. Currently, the order in which we perform checks coincides
+-- 1. In a straight-forward implementation, the order in which we
--- with the error we will generate. This is because during checks,
+-- perform checks will determine the error we generate. This is
--- once an error occurs, we do not perform any subsequent checks,
+-- because once an error occurs, we would abort and not perform
--- but rather return this error.
+-- any subsequent checks, but rather return the current error.
 --
 -- This is not a necessity: we could continue doing other checks,
 -- and choose the preferred error. However, that would in general

servant-server/test/Servant/Server/ErrorSpec.hs

@@ -42,7 +42,7 @@ errorOrderServer = \_ _ -> throwE err402
 
 errorOrderSpec :: Spec
 errorOrderSpec = describe "HTTP error order"
-           $ with (return $ serve errorOrderApi EmptyConfig errorOrderServer) $ do
+           $ with (return $ serve errorOrderApi errorOrderServer) $ do
   let badContentType  = (hContentType, "text/plain")
       badAccept       = (hAccept, "text/plain")
       badMethod       = methodGet
@@ -89,7 +89,7 @@ prioErrorsApi = Proxy
 prioErrorsSpec :: Spec
 prioErrorsSpec = describe "PrioErrors" $ do
   let server = return
-  with (return $ serve prioErrorsApi EmptyConfig server) $ do
+  with (return $ serve prioErrorsApi server) $ do
     let check (mdescr, method) path (cdescr, ctype, body) resp =
           it fulldescr $
             Test.Hspec.Wai.request method path [(hContentType, ctype)] body
@@ -154,7 +154,7 @@ errorRetryServer
 
 errorRetrySpec :: Spec
 errorRetrySpec = describe "Handler search"
-           $ with (return $ serve errorRetryApi EmptyConfig errorRetryServer) $ do
+           $ with (return $ serve errorRetryApi errorRetryServer) $ do
 
   let jsonCT      = (hContentType, "application/json")
       jsonAccept  = (hAccept, "application/json")
@@ -168,6 +168,10 @@ errorRetrySpec = describe "Handler search"
     request methodGet "a" [jsonCT, jsonAccept] jsonBody
      `shouldRespondWith` 200 { matchBody = Just $ encode (4 :: Int) }
 
+  it "should not continue when body cannot be decoded" $ do
+    request methodPost "a" [jsonCT, jsonAccept] "a string"
+     `shouldRespondWith` 400
+
 -- }}}
 ------------------------------------------------------------------------------
 -- * Error Choice {{{
@@ -194,7 +198,7 @@ errorChoiceServer = return 0
 
 errorChoiceSpec :: Spec
 errorChoiceSpec = describe "Multiple handlers return errors"
-                $ with (return $ serve errorChoiceApi EmptyConfig errorChoiceServer) $ do
+                $ with (return $ serve errorChoiceApi errorChoiceServer) $ do
 
   it "should respond with 404 if no path matches" $ do
     request methodGet "" [] "" `shouldRespondWith` 404

servant-server/test/Servant/Server/Internal/EnterSpec.hs

@@ -48,12 +48,12 @@ combinedReaderServer = enter fReader combinedReaderServer'
 
 enterSpec :: Spec
 enterSpec = describe "Enter" $ do
-  with (return (serve readerAPI EmptyConfig readerServer)) $ do
+  with (return (serve readerAPI readerServer)) $ do
 
     it "allows running arbitrary monads" $ do
       get "int" `shouldRespondWith` "1797"
       post "string" "3" `shouldRespondWith` "\"hi\""{ matchStatus = 200 }
 
-  with (return (serve combinedAPI EmptyConfig combinedReaderServer)) $ do
+  with (return (serve combinedAPI combinedReaderServer)) $ do
     it "allows combnation of enters" $ do
       get "bool" `shouldRespondWith` "true"

servant-server/test/Servant/Server/UsingConfigSpec.hs

@@ -30,7 +30,7 @@ testServer s = return s
 
 oneEntryApp :: Application
 oneEntryApp =
-  serve (Proxy :: Proxy OneEntryAPI) config testServer
+  serveWithConfig (Proxy :: Proxy OneEntryAPI) config testServer
   where
     config :: Config '[String]
     config = "configEntry" :. EmptyConfig
@@ -40,7 +40,7 @@ type OneEntryTwiceAPI =
   "bar" :> ExtractFromConfig :> Get '[JSON] String
 
 oneEntryTwiceApp :: Application
-oneEntryTwiceApp = serve (Proxy :: Proxy OneEntryTwiceAPI) config $
+oneEntryTwiceApp = serveWithConfig (Proxy :: Proxy OneEntryTwiceAPI) config $
   testServer :<|>
   testServer
   where
@@ -68,7 +68,7 @@ type InjectAPI =
     Get '[JSON] String
 
 injectApp :: Application
-injectApp = serve (Proxy :: Proxy InjectAPI) config $
+injectApp = serveWithConfig (Proxy :: Proxy InjectAPI) config $
   (\ s -> return s) :<|>
   (\ s -> return ("tagged: " ++ s))
   where
@@ -90,7 +90,7 @@ type WithBirdfaceAPI =
     "bar" :> ExtractFromConfig :> Get '[JSON] String
 
 withBirdfaceApp :: Application
-withBirdfaceApp = serve (Proxy :: Proxy WithBirdfaceAPI) config $
+withBirdfaceApp = serveWithConfig (Proxy :: Proxy WithBirdfaceAPI) config $
   testServer :<|>
   testServer
   where
@@ -112,7 +112,7 @@ type NamedConfigAPI =
     ExtractFromConfig :> Get '[JSON] String)
 
 namedConfigApp :: Application
-namedConfigApp = serve (Proxy :: Proxy NamedConfigAPI) config return
+namedConfigApp = serveWithConfig (Proxy :: Proxy NamedConfigAPI) config return
   where
     config :: Config '[NamedConfig "sub" '[String]]
     config = NamedConfig ("descend" :. EmptyConfig) :. EmptyConfig

servant-server/test/Servant/ServerSpec.hs

@@ -49,7 +49,7 @@ import           Servant.API                ((:<|>) (..), (:>), Capture, Delete,
                                              StdMethod (..), Verb, addHeader)
 import           Servant.API.Internal.Test.ComprehensiveAPI
 import           Servant.Server             (ServantErr (..), Server, err404,
-                                             serve, Config(EmptyConfig))
+                                             serve, serveWithConfig, Config(EmptyConfig))
 import           Test.Hspec                 (Spec, context, describe, it,
                                              shouldBe, shouldContain)
 import           Test.Hspec.Wai             (get, liftIO, matchHeaders,
@@ -67,7 +67,7 @@ import           Servant.Server.Internal.Config
 -- * comprehensive api test
 
 -- This declaration simply checks that all instances are in place.
-_ = serve comprehensiveAPI comprehensiveApiConfig
+_ = serveWithConfig comprehensiveAPI comprehensiveApiConfig
 
 comprehensiveApiConfig :: Config '[NamedConfig "foo" '[]]
 comprehensiveApiConfig = NamedConfig EmptyConfig :. EmptyConfig
@@ -112,7 +112,7 @@ verbSpec = describe "Servant.API.Verb" $ do
       wrongMethod m = if m == methodPatch then methodPost else methodPatch
       test desc api method (status :: Int) = context desc $
 
-        with (return $ serve api EmptyConfig server) $ do
+        with (return $ serve api server) $ do
 
           -- HEAD and 214/215 need not return bodies
           unless (status `elem` [214, 215] || method == methodHead) $
@@ -187,7 +187,7 @@ captureServer legs = case legs of
 captureSpec :: Spec
 captureSpec = do
   describe "Servant.API.Capture" $ do
-    with (return (serve captureApi EmptyConfig captureServer)) $ do
+    with (return (serve captureApi captureServer)) $ do
 
       it "can capture parts of the 'pathInfo'" $ do
         response <- get "/2"
@@ -198,7 +198,6 @@ captureSpec = do
 
     with (return (serve
         (Proxy :: Proxy (Capture "captured" String :> Raw))
-        EmptyConfig
         (\ "captured" request_ respond ->
             respond $ responseLBS ok200 [] (cs $ show $ pathInfo request_)))) $ do
       it "strips the captured path snippet from pathInfo" $ do
@@ -232,7 +231,7 @@ queryParamSpec :: Spec
 queryParamSpec = do
   describe "Servant.API.QueryParam" $ do
       it "allows retrieving simple GET parameters" $
-        (flip runSession) (serve queryParamApi EmptyConfig qpServer) $ do
+        (flip runSession) (serve queryParamApi qpServer) $ do
           let params1 = "?name=bob"
           response1 <- Network.Wai.Test.request defaultRequest{
             rawQueryString = params1,
@@ -244,7 +243,7 @@ queryParamSpec = do
              }
 
       it "allows retrieving lists in GET parameters" $
-        (flip runSession) (serve queryParamApi EmptyConfig qpServer) $ do
+        (flip runSession) (serve queryParamApi qpServer) $ do
           let params2 = "?names[]=bob&names[]=john"
           response2 <- Network.Wai.Test.request defaultRequest{
             rawQueryString = params2,
@@ -258,7 +257,7 @@ queryParamSpec = do
 
 
       it "allows retrieving value-less GET parameters" $
-        (flip runSession) (serve queryParamApi EmptyConfig qpServer) $ do
+        (flip runSession) (serve queryParamApi qpServer) $ do
           let params3 = "?capitalize"
           response3 <- Network.Wai.Test.request defaultRequest{
             rawQueryString = params3,
@@ -310,7 +309,7 @@ reqBodySpec = describe "Servant.API.ReqBody" $ do
       mkReq method x = Test.Hspec.Wai.request method x
          [(hContentType, "application/json;charset=utf-8")]
 
-  with (return $ serve reqBodyApi EmptyConfig server) $ do
+  with (return $ serve reqBodyApi server) $ do
 
     it "passes the argument to the handler" $ do
       response <- mkReq methodPost "" (encode alice)
@@ -343,13 +342,13 @@ headerSpec = describe "Servant.API.Header" $ do
         expectsString (Just x) = when (x /= "more from you") $ error "Expected more from you"
         expectsString Nothing  = error "Expected a string"
 
-    with (return (serve headerApi EmptyConfig expectsInt)) $ do
+    with (return (serve headerApi expectsInt)) $ do
         let delete' x = Test.Hspec.Wai.request methodDelete x [("MyHeader", "5")]
 
         it "passes the header to the handler (Int)" $
             delete' "/" "" `shouldRespondWith` 200
 
-    with (return (serve headerApi EmptyConfig expectsString)) $ do
+    with (return (serve headerApi expectsString)) $ do
         let delete' x = Test.Hspec.Wai.request methodDelete x [("MyHeader", "more from you")]
 
         it "passes the header to the handler (String)" $
@@ -373,7 +372,7 @@ rawSpec :: Spec
 rawSpec = do
   describe "Servant.API.Raw" $ do
     it "runs applications" $ do
-      (flip runSession) (serve rawApi EmptyConfig (rawApplication (const (42 :: Integer)))) $ do
+      (flip runSession) (serve rawApi (rawApplication (const (42 :: Integer)))) $ do
         response <- Network.Wai.Test.request defaultRequest{
           pathInfo = ["foo"]
          }
@@ -381,7 +380,7 @@ rawSpec = do
           simpleBody response `shouldBe` "42"
 
     it "gets the pathInfo modified" $ do
-      (flip runSession) (serve rawApi EmptyConfig (rawApplication pathInfo)) $ do
+      (flip runSession) (serve rawApi (rawApplication pathInfo)) $ do
         response <- Network.Wai.Test.request defaultRequest{
           pathInfo = ["foo", "bar"]
          }
@@ -415,7 +414,7 @@ alternativeServer =
 alternativeSpec :: Spec
 alternativeSpec = do
   describe "Servant.API.Alternative" $ do
-    with (return $ serve alternativeApi EmptyConfig alternativeServer) $ do
+    with (return $ serve alternativeApi alternativeServer) $ do
 
       it "unions endpoints" $ do
         response <- get "/foo"
@@ -450,7 +449,7 @@ responseHeadersServer = let h = return $ addHeader 5 $ addHeader "kilroy" "hi"
 
 responseHeadersSpec :: Spec
 responseHeadersSpec = describe "ResponseHeaders" $ do
-  with (return $ serve (Proxy :: Proxy ResponseHeadersApi) EmptyConfig responseHeadersServer) $ do
+  with (return $ serve (Proxy :: Proxy ResponseHeadersApi) responseHeadersServer) $ do
 
     let methods = [methodGet, methodPost, methodPut, methodPatch]
 
@@ -516,7 +515,7 @@ miscServ = versionHandler
         hostHandler = return . show
 
 miscCombinatorSpec :: Spec
-miscCombinatorSpec = with (return $ serve miscApi EmptyConfig miscServ) $
+miscCombinatorSpec = with (return $ serve miscApi miscServ) $
   describe "Misc. combinators for request inspection" $ do
     it "Successfully gets the HTTP version specified in the request" $
       go "/version" "\"HTTP/1.0\""

servant-server/test/Servant/Utils/StaticFilesSpec.hs

@@ -16,7 +16,7 @@ import           Test.Hspec                (Spec, around_, describe, it)
 import           Test.Hspec.Wai            (get, shouldRespondWith, with)
 
 import           Servant.API               ((:<|>) ((:<|>)), Capture, Get, Raw, (:>), JSON)
-import           Servant.Server            (Server, serve, Config(EmptyConfig))
+import           Servant.Server            (Server, serve)
 import           Servant.ServerSpec        (Person (Person))
 import           Servant.Utils.StaticFiles (serveDirectory)
 
@@ -29,7 +29,7 @@ api :: Proxy Api
 api = Proxy
 
 app :: Application
-app = serve api EmptyConfig server
+app = serve api server
 
 server :: Server Api
 server =

servant/src/Servant/API/Verbs.hs

@@ -34,15 +34,15 @@ data Verb (method :: k1) (statusCode :: Nat) (contentTypes :: [*]) a
 -- the relevant information is summarily presented here.
 
 -- | 'GET' with 200 status code.
-type Get    contentTypes a = Verb 'GET    200 contentTypes a
+type Get    = Verb 'GET    200
 -- | 'POST' with 200 status code.
-type Post   contentTypes a = Verb 'POST   200 contentTypes a
+type Post   = Verb 'POST   200
 -- | 'PUT' with 200 status code.
-type Put    contentTypes a = Verb 'PUT    200 contentTypes a
+type Put    = Verb 'PUT    200
 -- | 'DELETE' with 200 status code.
-type Delete contentTypes a = Verb 'DELETE 200 contentTypes a
+type Delete = Verb 'DELETE 200
 -- | 'PATCH' with 200 status code.
-type Patch  contentTypes a = Verb 'PATCH  200 contentTypes a
+type Patch  = Verb 'PATCH  200
 
 -- * Other responses
 
@@ -58,7 +58,7 @@ type Patch  contentTypes a = Verb 'PATCH  200 contentTypes a
 
 -- | 'POST' with 201 status code.
 --
-type PostCreated contentTypes a = Verb 'POST 201 contentTypes a
+type PostCreated = Verb 'POST 201
 
 
 -- ** 202 Accepted
@@ -69,15 +69,15 @@ type PostCreated contentTypes a = Verb 'POST 201 contentTypes a
 -- estimate of when the processing will be finished.
 
 -- | 'GET' with 202 status code.
-type GetAccepted contentTypes a = Verb 'GET 202 contentTypes a
+type GetAccepted    = Verb 'GET 202
 -- | 'POST' with 202 status code.
-type PostAccepted contentTypes a = Verb 'POST 202 contentTypes a
+type PostAccepted   = Verb 'POST 202
 -- | 'DELETE' with 202 status code.
-type DeleteAccepted contentTypes a = Verb 'DELETE 202 contentTypes a
+type DeleteAccepted = Verb 'DELETE 202
 -- | 'PATCH' with 202 status code.
-type PatchAccepted contentTypes a = Verb 'PATCH 202 contentTypes a
+type PatchAccepted  = Verb 'PATCH 202
 -- | 'PUT' with 202 status code.
-type PutAccepted contentTypes a = Verb 'PUT 202 contentTypes a
+type PutAccepted    = Verb 'PUT 202
 
 
 -- ** 203 Non-Authoritative Information
@@ -86,15 +86,15 @@ type PutAccepted contentTypes a = Verb 'PUT 202 contentTypes a
 -- information may come from a third-party.
 
 -- | 'GET' with 203 status code.
-type GetNonAuthoritative contentTypes a = Verb 'GET 203 contentTypes a
+type GetNonAuthoritative    = Verb 'GET 203
 -- | 'POST' with 203 status code.
-type PostNonAuthoritative contentTypes a = Verb 'POST 203 contentTypes a
+type PostNonAuthoritative   = Verb 'POST 203
 -- | 'DELETE' with 203 status code.
-type DeleteNonAuthoritative contentTypes a = Verb 'DELETE 203 contentTypes a
+type DeleteNonAuthoritative = Verb 'DELETE 203
 -- | 'PATCH' with 203 status code.
-type PatchNonAuthoritative contentTypes a = Verb 'PATCH 203 contentTypes a
+type PatchNonAuthoritative  = Verb 'PATCH 203
 -- | 'PUT' with 203 status code.
-type PutNonAuthoritative contentTypes a = Verb 'PUT 203 contentTypes a
+type PutNonAuthoritative    = Verb 'PUT 203
 
 
 -- ** 204 No Content
@@ -105,15 +105,15 @@ type PutNonAuthoritative contentTypes a = Verb 'PUT 203 contentTypes a
 -- If the document view should be reset, use @205 Reset Content@.
 
 -- | 'GET' with 204 status code.
-type GetNoContent contentTypes noContent = Verb 'GET 204 contentTypes noContent
+type GetNoContent    = Verb 'GET 204
 -- | 'POST' with 204 status code.
-type PostNoContent contentTypes noContent = Verb 'POST 204 contentTypes noContent
+type PostNoContent   = Verb 'POST 204
 -- | 'DELETE' with 204 status code.
-type DeleteNoContent contentTypes noContent = Verb 'DELETE 204 contentTypes noContent
+type DeleteNoContent = Verb 'DELETE 204
 -- | 'PATCH' with 204 status code.
-type PatchNoContent contentTypes noContent = Verb 'PATCH 204 contentTypes noContent
+type PatchNoContent  = Verb 'PATCH 204
 -- | 'PUT' with 204 status code.
-type PutNoContent contentTypes noContent = Verb 'PUT 204 contentTypes noContent
+type PutNoContent    = Verb 'PUT 204
 
 
 -- ** 205 Reset Content
@@ -124,15 +124,15 @@ type PutNoContent contentTypes noContent = Verb 'PUT 204 contentTypes noContent
 -- If the document view should not be reset, use @204 No Content@.
 
 -- | 'GET' with 205 status code.
-type GetResetContent contentTypes noContent = Verb 'GET 205 contentTypes noContent
+type GetResetContent    = Verb 'GET 205
 -- | 'POST' with 205 status code.
-type PostResetContent contentTypes noContent = Verb 'POST 205 contentTypes noContent
+type PostResetContent   = Verb 'POST 205
 -- | 'DELETE' with 205 status code.
-type DeleteResetContent contentTypes noContent = Verb 'DELETE 205 contentTypes noContent
+type DeleteResetContent = Verb 'DELETE 205
 -- | 'PATCH' with 205 status code.
-type PatchResetContent contentTypes noContent = Verb 'PATCH 205 contentTypes noContent
+type PatchResetContent  = Verb 'PATCH 205
 -- | 'PUT' with 205 status code.
-type PutResetContent contentTypes noContent = Verb 'PUT 205 contentTypes noContent
+type PutResetContent    = Verb 'PUT 205
 
 
 -- ** 206 Partial Content
@@ -144,7 +144,7 @@ type PutResetContent contentTypes noContent = Verb 'PUT 205 contentTypes noConte
 -- RFC7233 Section 4.1>
 
 -- | 'GET' with 206 status code.
-type GetPartialContent contentTypes noContent = Verb 'GET 206 contentTypes noContent
+type GetPartialContent = Verb 'GET 206
 
 
 class ReflectMethod a where