Update to wai/wai-extra/warp 3.0

Network/Wai/Middleware/Static.hs

@@ -125,18 +125,18 @@ static = staticPolicy mempty
 staticPolicy :: Policy -> Middleware
 staticPolicy p = unsafeStaticPolicy $ noDots >-> isNotAbsolute >-> p
 
--- | Serve static files subject to a 'Policy'. Unlike 'static' and 'staticPolicy', this 
+-- | Serve static files subject to a 'Policy'. Unlike 'static' and 'staticPolicy', this
 -- has no policies enabled by default, and is hence insecure.
 unsafeStaticPolicy :: Policy -> Middleware
-unsafeStaticPolicy p app req =
-    maybe (app req)
+unsafeStaticPolicy p app req callback =
+    maybe (app req callback)
           (\fp -> do exists <- liftIO $ doesFileExist fp
                      if exists
-                        then return $ responseFile status200
-                                                   [("Content-Type", getMimeType fp)]
-                                                   fp
-                                                   Nothing
-                        else app req)
+                        then callback $ responseFile status200
+                                                     [("Content-Type", getMimeType fp)]
+                                                     fp
+                                                     Nothing
+                        else app req callback)
           (tryPolicy p $ T.unpack $ T.intercalate "/" $ pathInfo req)
 
 type Ascii = B.ByteString

Web/Scotty.hs

@@ -24,7 +24,7 @@ module Web.Scotty
       --
       -- | Note: only one of these should be present in any given route
       -- definition, as they completely replace the current 'Response' body.
-    , text, html, file, json, source, raw
+    , text, html, file, json, stream, raw
       -- ** Exceptions
     , raise, rescue, next, defaultHandler
       -- * Parsing Parameters
@@ -36,21 +36,18 @@ module Web.Scotty
 -- With the exception of this, everything else better just import types.
 import qualified Web.Scotty.Trans as Trans
 
-import Blaze.ByteString.Builder (Builder)
-
 import Data.Aeson (FromJSON, ToJSON)
 import Data.ByteString.Lazy.Char8 (ByteString)
-import Data.Conduit (Flush, Source)
 import Data.Text.Lazy (Text)
 
 import Network.HTTP.Types (Status, StdMethod)
-import Network.Wai (Application, Middleware, Request)
+import Network.Wai (Application, Middleware, Request, StreamingBody)
 import Network.Wai.Handler.Warp (Port)
 
 import Web.Scotty.Types (ScottyT, ActionT, Param, RoutePattern, Options, File)
 
 type ScottyM = ScottyT Text IO
-type ActionM = ActionT Text IO 
+type ActionM = ActionT Text IO
 
 -- | Run a scotty application using the warp server.
 scotty :: Port -> ScottyM () -> IO ()
@@ -65,14 +62,14 @@ scottyOpts opts = Trans.scottyOptsT opts id id
 scottyApp :: ScottyM () -> IO Application
 scottyApp = Trans.scottyAppT id id
 
--- | Global handler for uncaught exceptions. 
+-- | Global handler for uncaught exceptions.
 --
--- Uncaught exceptions normally become 500 responses. 
+-- Uncaught exceptions normally become 500 responses.
 -- You can use this to selectively override that behavior.
 --
 -- Note: IO exceptions are lifted into Scotty exceptions by default.
 -- This has security implications, so you probably want to provide your
--- own defaultHandler in production which does not send out the error 
+-- own defaultHandler in production which does not send out the error
 -- strings as 500 responses.
 defaultHandler :: (Text -> ActionM ()) -> ScottyM ()
 defaultHandler = Trans.defaultHandler
@@ -198,11 +195,11 @@ file = Trans.file
 json :: ToJSON a => a -> ActionM ()
 json = Trans.json
 
--- | Set the body of the response to a Source. Doesn't set the
+-- | Set the body of the response to a StreamingBody. Doesn't set the
 -- \"Content-Type\" header, so you probably want to do that on your
 -- own with 'setHeader'.
-source :: Source IO (Flush Builder) -> ActionM ()
-source = Trans.source
+stream :: StreamingBody -> ActionM ()
+stream = Trans.stream
 
 -- | Set the body of the response to the given 'BL.ByteString' value. Doesn't set the
 -- \"Content-Type\" header, so you probably want to do that on your own with 'setHeader'.

Web/Scotty/Action.hs

@@ -20,16 +20,16 @@ module Web.Scotty.Action
     , request
     , rescue
     , setHeader
-    , source
     , status
+    , stream
     , text
     , Param
     , Parsable(..)
       -- private to Scotty
     , runAction
     ) where
 
-import Blaze.ByteString.Builder (Builder, fromLazyByteString)
+import Blaze.ByteString.Builder (fromLazyByteString)
 
 import Control.Monad.Error
 import Control.Monad.Reader
@@ -39,7 +39,6 @@ import qualified Data.Aeson as A
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as BL
 import qualified Data.CaseInsensitive as CI
-import Data.Conduit (Flush, Source)
 import Data.Default (def)
 import Data.Monoid (mconcat)
 import qualified Data.Text as ST
@@ -139,7 +138,7 @@ headers :: (ScottyError e, Monad m) => ActionT e m [(T.Text, T.Text)]
 headers = do
     hs <- liftM requestHeaders request
     return [ ( strictByteStringToLazyText (CI.original k)
-             , strictByteStringToLazyText v)  
+             , strictByteStringToLazyText v)
            | (k,v) <- hs ]
 
 -- | Get the request body.
@@ -198,7 +197,7 @@ instance Parsable () where
 
 instance (Parsable a) => Parsable [a] where parseParam = parseParamList
 
-instance Parsable Bool where 
+instance Parsable Bool where
     parseParam t = if t' == T.toCaseFold "true"
                    then Right True
                    else if t' == T.toCaseFold "false"
@@ -262,8 +261,8 @@ json v = do
 -- | Set the body of the response to a Source. Doesn't set the
 -- \"Content-Type\" header, so you probably want to do that on your
 -- own with 'setHeader'.
-source :: (ScottyError e, Monad m) => Source IO (Flush Builder) -> ActionT e m ()
-source = ActionT . MS.modify . setContent . ContentSource
+stream :: (ScottyError e, Monad m) => StreamingBody -> ActionT e m ()
+stream = ActionT . MS.modify . setContent . ContentStream
 
 -- | Set the body of the response to the given 'BL.ByteString' value. Doesn't set the
 -- \"Content-Type\" header, so you probably want to do that on your

Web/Scotty/Route.hs

@@ -1,20 +1,17 @@
-{-# LANGUAGE OverloadedStrings, FlexibleContexts, FlexibleInstances, RankNTypes #-}
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, LambdaCase,
+             OverloadedStrings, RankNTypes, ScopedTypeVariables #-}
 module Web.Scotty.Route
     ( get, post, put, delete, patch, addroute, matchAny, notFound,
       capture, regex, function, literal
     ) where
 
 import Control.Arrow ((***))
+import Control.Concurrent.MVar
 import Control.Monad.Error
 import qualified Control.Monad.State as MS
 
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as BL
-import Data.Conduit (($$), (=$))
-import Data.Conduit.Binary (sourceLbs)
-import Data.Conduit.Lazy (lazyConsume)
-import Data.Conduit.List (consume)
-import Data.Either (partitionEithers)
 import Data.Maybe (fromMaybe)
 import Data.Monoid (mconcat)
 import Data.String (fromString)
@@ -108,26 +105,39 @@ matchRoute (Capture pat)  req = go (T.split (=='/') pat) (T.split (=='/') $ path
 path :: Request -> T.Text
 path = T.fromStrict . TS.cons '/' . TS.intercalate "/" . pathInfo
 
--- Stolen from wai-extra, modified to accept body as lazy ByteString
+-- Stolen from wai-extra's Network.Wai.Parse, modified to accept body as list of Bytestrings.
+-- Reason: WAI's requestBody is an IO action that returns the body as chunks. Once read,
+-- they can't be read again. We read them into a lazy Bytestring, so Scotty user can get
+-- the raw body, even if they also want to call wai-extra's parsing routines.
 parseRequestBody :: MonadIO m
-                 => BL.ByteString
+                 => [B.ByteString]
                  -> Parse.BackEnd y
                  -> Request
                  -> m ([Parse.Param], [Parse.File y])
-parseRequestBody b s r =
+parseRequestBody bl s r =
     case Parse.getRequestBodyType r of
         Nothing -> return ([], [])
-        Just rbt -> liftIO $ liftM partitionEithers $ sourceLbs b $$ Parse.conduitRequestBody s rbt =$ consume
-
-mkEnv :: MonadIO m => Request -> [Param] -> m ActionEnv
+        Just rbt -> do
+            mvar <- liftIO $ newMVar bl -- MVar is a bit of a hack so we don't have to inline
+                                        -- large portions of Network.Wai.Parse
+            let provider = takeMVar mvar >>= \case
+                                                []     -> putMVar mvar [] >> return B.empty
+                                                (b:bs) -> putMVar mvar bs >> return b
+            liftIO $ Parse.sinkRequestBody s rbt provider
+
+mkEnv :: forall m. MonadIO m => Request -> [Param] -> m ActionEnv
 mkEnv req captures = do
-    b <- liftIO $ liftM BL.fromChunks $ lazyConsume (requestBody req)
+    let rbody = requestBody req
+        takeAll :: ([B.ByteString] -> m [B.ByteString]) -> m [B.ByteString]
+        takeAll prefix = liftIO rbody >>= \ b -> if B.null b then prefix [] else takeAll (prefix . (b:))
+    bs <- takeAll return
 
-    (formparams, fs) <- liftIO $ parseRequestBody b Parse.lbsBackEnd req
+    (formparams, fs) <- liftIO $ parseRequestBody bs Parse.lbsBackEnd req
 
     let convert (k, v) = (strictByteStringToLazyText k, strictByteStringToLazyText v)
         parameters = captures ++ map convert formparams ++ queryparams
         queryparams = parseEncodedParams $ rawQueryString req
+        b = BL.fromChunks bs
 
     return $ Env req parameters b [ (strictByteStringToLazyText k, fi) | (k,fi) <- fs ]
 

Web/Scotty/Trans.hs

@@ -28,7 +28,7 @@ module Web.Scotty.Trans
       --
       -- | Note: only one of these should be present in any given route
       -- definition, as they completely replace the current 'Response' body.
-    , text, html, file, json, source, raw
+    , text, html, file, json, stream, raw
       -- ** Exceptions
     , raise, rescue, next, defaultHandler, ScottyError(..)
       -- * Parsing Parameters
@@ -89,21 +89,21 @@ scottyAppT :: (Monad m, Monad n)
            -> n Application
 scottyAppT runM runActionToIO defs = do
     s <- runM $ execStateT (runS defs) def
-    let rapp = runActionToIO . foldl (flip ($)) notFoundApp (routes s)
+    let rapp = \ req callback -> runActionToIO (foldl (flip ($)) notFoundApp (routes s) req) >>= callback
     return $ foldl (flip ($)) rapp (middlewares s)
 
 notFoundApp :: Monad m => Scotty.Application m
 notFoundApp _ = return $ responseBuilder status404 [("Content-Type","text/html")]
                        $ fromByteString "<h1>404: File Not Found!</h1>"
 
--- | Global handler for uncaught exceptions. 
+-- | Global handler for uncaught exceptions.
 --
--- Uncaught exceptions normally become 500 responses. 
+-- Uncaught exceptions normally become 500 responses.
 -- You can use this to selectively override that behavior.
 --
 -- Note: IO exceptions are lifted into 'ScottyError's by 'stringError'.
 -- This has security implications, so you probably want to provide your
--- own defaultHandler in production which does not send out the error 
+-- own defaultHandler in production which does not send out the error
 -- strings as 500 responses.
 defaultHandler :: Monad m => (e -> ActionT e m ()) -> ScottyT e m ()
 defaultHandler f = ScottyT $ modify $ addHandler $ Just f

Web/Scotty/Types.hs

@@ -10,7 +10,6 @@ import           Control.Monad.Reader
 import           Control.Monad.State
 
 import           Data.ByteString.Lazy.Char8 (ByteString)
-import qualified Data.Conduit as C
 import           Data.Default (Default, def)
 import           Data.Monoid (mempty)
 import           Data.String (IsString(..))
@@ -42,7 +41,7 @@ type Middleware m = Application m -> Application m
 type Application m = Request -> m Response
 
 --------------- Scotty Applications -----------------
-data ScottyState e m = 
+data ScottyState e m =
     ScottyState { middlewares :: [Wai.Middleware]
                 , routes :: [Middleware m]
                 , handler :: ErrorHandler e m
@@ -72,7 +71,7 @@ data ActionError e = Redirect Text
                    | ActionError e
 
 -- | In order to use a custom exception type (aside from 'Text'), you must
--- define an instance of 'ScottyError' for that type. 
+-- define an instance of 'ScottyError' for that type.
 class ScottyError e where
     stringError :: String -> e
     showError :: e -> Text
@@ -87,7 +86,7 @@ instance ScottyError e => ScottyError (ActionError e) where
     showError Next            = pack "Next"
     showError (ActionError e) = showError e
 
-instance ScottyError e => Error (ActionError e) where 
+instance ScottyError e => Error (ActionError e) where
     strMsg = stringError
 
 type ErrorHandler e m = Maybe (e -> ActionT e m ())
@@ -100,12 +99,12 @@ type File = (Text, FileInfo ByteString)
 data ActionEnv = Env { getReq    :: Request
                      , getParams :: [Param]
                      , getBody   :: ByteString
-                     , getFiles  :: [File] 
+                     , getFiles  :: [File]
                      }
 
 data Content = ContentBuilder Builder
              | ContentFile    FilePath
-             | ContentSource  (C.Source IO (C.Flush Builder))
+             | ContentStream  StreamingBody
 
 data ScottyResponse = SR { srStatus  :: Status
                          , srHeaders :: ResponseHeaders
@@ -136,5 +135,5 @@ data RoutePattern = Capture   Text
                   | Literal   Text
                   | Function  (Request -> Maybe [Param])
 
-instance IsString RoutePattern where 
+instance IsString RoutePattern where
     fromString = Capture . pack

Web/Scotty/Util.hs

@@ -34,11 +34,14 @@ setHeaderWith f sr = sr { srHeaders = f (srHeaders sr) }
 setStatus :: Status -> ScottyResponse -> ScottyResponse
 setStatus s sr = sr { srStatus = s }
 
+-- Note: we currently don't support responseRaw, which may be useful
+-- for websockets. However, we always read the request body, which
+-- is incompatible with responseRaw responses.
 mkResponse :: ScottyResponse -> Response
 mkResponse sr = case srContent sr of
                     ContentBuilder b  -> responseBuilder s h b
                     ContentFile f     -> responseFile s h f Nothing
-                    ContentSource src -> responseSource s h src
+                    ContentStream str -> responseStream s h str
     where s = srStatus sr
           h = srHeaders sr
 

changelog.md

@@ -1,3 +1,12 @@
+## 0.8.0
+
+* Upgrade to wai/wai-extra/warp 3.0
+
+* No longer depend on conduit/conduit-extra
+
+* The `source` response method has been removed in favor of new `stream` response,
+  which matches changes in WAI 3.0.
+
 ## 0.7.3
 
 * Bump upper bound for `case-insensitive`, `mtl` and `transformers`.
@@ -65,7 +74,7 @@
 * Removed lambda action syntax. This will return when we have a better
   story for typesafe routes.
 
-* `reqHeader :: Text -> ActionM Text` ==> 
+* `reqHeader :: Text -> ActionM Text` ==>
   `reqHeader :: Text -> ActionM (Maybe Text)`
 
 * New `raw` method to set body to a raw `ByteString`

scotty.cabal

@@ -1,5 +1,5 @@
 Name:                scotty
-Version:             0.7.3
+Version:             0.8.0
 Synopsis:            Haskell web framework inspired by Ruby's Sinatra, using WAI and Warp
 Homepage:            https://github.com/scotty-web/scotty
 Bug-reports:         https://github.com/scotty-web/scotty/issues
@@ -73,17 +73,15 @@ Library
                        blaze-builder    >= 0.3.3.0  && < 0.4,
                        bytestring       >= 0.10.0.2 && < 0.11,
                        case-insensitive >= 1.0.0.1  && < 1.3,
-                       conduit          >= 1.1      && < 1.2,
-                       conduit-extra    >= 1.1      && < 1.2,
                        data-default     >= 0.5.3    && < 0.6,
                        http-types       >= 0.8.2    && < 0.9,
                        mtl              >= 2.1.2    && < 2.3,
                        regex-compat     >= 0.95.1   && < 0.96,
                        text             >= 0.11.3.1 && < 1.2,
                        transformers     >= 0.3.0.0  && < 0.5,
-                       wai              >= 2.0.0    && < 2.2,
-                       wai-extra        >= 2.0.1    && < 2.2,
-                       warp             >= 2.1.1    && < 2.2
+                       wai              >= 3.0.0    && < 3.1,
+                       wai-extra        >= 3.0.0    && < 3.1,
+                       warp             >= 3.0.0    && < 3.1
 
   GHC-options: -Wall -fno-warn-orphans
 
@@ -97,7 +95,7 @@ test-suite spec
                        http-types,
                        wai,
                        hspec            >= 1.9.2,
-                       wai-test         >= 2.0.0,
+                       wai-extra        >= 3.0.0,
                        scotty
   GHC-options:         -Wall -fno-warn-orphans