diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -# Scotty +# Scotty [![Build Status](https://travis-ci.org/scotty-web/scotty.svg)](https://travis-ci.org/scotty-web/scotty)[![Coverage Status](https://coveralls.io/repos/scotty-web/scotty/badge.png?branch=master)](https://coveralls.io/r/scotty-web/scotty?branch=master) A Haskell web framework inspired by Ruby's Sinatra, using WAI and Warp. diff --git a/Web/Scotty.hs b/Web/Scotty.hs --- a/Web/Scotty.hs +++ b/Web/Scotty.hs @@ -17,14 +17,14 @@ -- ** Route Patterns , capture, regex, function, literal -- ** Accessing the Request, Captures, and Query Parameters - , request, header, reqHeader, headers, body, param, params, jsonData, files + , request, header, headers, body, param, params, jsonData, files -- ** Modifying the Response and Redirecting , status, addHeader, setHeader, redirect -- ** Setting Response Body -- -- | 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, source, raw -- ** Exceptions , raise, rescue, next, defaultHandler -- * Parsing Parameters @@ -35,22 +35,23 @@ -- With the exception of this, everything else better just import types. import qualified Web.Scotty.Trans as Trans +import qualified Web.Scotty.Action as Action -- for 'source', to avoid deprecation warning on Trans.source 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 Data.Conduit (Flush, Source) 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 +66,14 @@ 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 @@ -134,11 +135,6 @@ header :: Text -> ActionM (Maybe Text) header = Trans.header --- | Get a request header. Header name is case-insensitive. (Deprecated in favor of `header`.) -reqHeader :: Text -> ActionM (Maybe Text) -reqHeader = Trans.header -{-# DEPRECATED reqHeader "Use header instead. reqHeader will be removed in the next release." #-} - -- | Get all the request headers. Header names are case-insensitive. headers :: ActionM [(Text, Text)] headers = Trans.headers @@ -198,11 +194,18 @@ json :: ToJSON a => a -> ActionM () json = Trans.json +-- | 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'. +stream :: StreamingBody -> ActionM () +stream = Trans.stream + -- | 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 :: Source IO (Flush Builder) -> ActionM () -source = Trans.source +source = Action.source +{-# DEPRECATED source "Use 'stream' instead. This will be removed in the next release." #-} -- | 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'. diff --git a/Web/Scotty/Action.hs b/Web/Scotty/Action.hs --- a/Web/Scotty/Action.hs +++ b/Web/Scotty/Action.hs @@ -16,12 +16,12 @@ , raw , readEither , redirect - , reqHeader -- Deprecated , request , rescue , setHeader - , source , status + , stream + , source -- Deprecated , text , Param , Parsable(..) @@ -39,12 +39,13 @@ 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 Data.Conduit +import qualified Data.Conduit.List as CL +import Data.Default (def) +import Data.Monoid (mconcat) import qualified Data.Text as ST import qualified Data.Text.Lazy as T -import Data.Text.Lazy.Encoding (encodeUtf8) +import Data.Text.Lazy.Encoding (encodeUtf8) import Network.HTTP.Types import Network.Wai @@ -123,11 +124,6 @@ files :: (ScottyError e, Monad m) => ActionT e m [File] files = ActionT $ liftM getFiles ask --- | Get a request header. Header name is case-insensitive. (Deprecated in favor of `header`.) -reqHeader :: (ScottyError e, Monad m) => T.Text -> ActionT e m (Maybe T.Text) -reqHeader = header -{-# DEPRECATED reqHeader "Use header instead. This will be removed in the next release." #-} - -- | Get a request header. Header name is case-insensitive. header :: (ScottyError e, Monad m) => T.Text -> ActionT e m (Maybe T.Text) header k = do @@ -139,7 +135,7 @@ headers = do hs <- liftM requestHeaders request return [ ( strictByteStringToLazyText (CI.original k) - , strictByteStringToLazyText v) + , strictByteStringToLazyText v) | (k,v) <- hs ] -- | Get the request body. @@ -198,7 +194,7 @@ 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 +258,18 @@ -- | 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'. +stream :: (ScottyError e, Monad m) => StreamingBody -> ActionT e m () +stream = ActionT . MS.modify . setContent . ContentStream + +-- | 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 +source src = stream $ \send flush -> src $$ CL.mapM_ (\mbuilder -> + case mbuilder of + Chunk b -> send b + Flush -> flush) +-- Deprecated, but pragma is in Web.Scotty and Web.Scotty.Trans -- | 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 diff --git a/Web/Scotty/Route.hs b/Web/Scotty/Route.hs --- a/Web/Scotty/Route.hs +++ b/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 @@ 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 + 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 :: MonadIO m => Request -> [Param] -> m ActionEnv +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 ] diff --git a/Web/Scotty/Trans.hs b/Web/Scotty/Trans.hs --- a/Web/Scotty/Trans.hs +++ b/Web/Scotty/Trans.hs @@ -21,14 +21,14 @@ -- ** Route Patterns , capture, regex, function, literal -- ** Accessing the Request, Captures, and Query Parameters - , request, header, reqHeader, headers, body, param, params, jsonData, files + , request, header, headers, body, param, params, jsonData, files -- ** Modifying the Response and Redirecting , status, addHeader, setHeader, redirect -- ** Setting Response Body -- -- | 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, source, raw -- ** Exceptions , raise, rescue, next, defaultHandler, ScottyError(..) -- * Parsing Parameters @@ -39,23 +39,32 @@ , ScottyT, ActionT ) where -import Blaze.ByteString.Builder (fromByteString) +import Blaze.ByteString.Builder (Builder, fromByteString) import Control.Monad (when) import Control.Monad.State (execStateT, modify) import Control.Monad.IO.Class +import Data.Conduit (Flush, Source) import Data.Default (def) import Network.HTTP.Types (status404) import Network.Wai import Network.Wai.Handler.Warp (Port, runSettings, setPort, getPort) -import Web.Scotty.Action +import Web.Scotty.Action hiding (source) +import qualified Web.Scotty.Action as Action import Web.Scotty.Route import Web.Scotty.Types hiding (Application, Middleware) import qualified Web.Scotty.Types as Scotty +-- | 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 = Action.source +{-# DEPRECATED source "Use 'stream' instead. This will be removed in the next release." #-} + -- | Run a scotty application using the warp server. -- NB: scotty p === scottyT p id id scottyT :: (Monad m, MonadIO n) @@ -89,21 +98,21 @@ -> 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 "

404: File Not Found!

" --- | 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 diff --git a/Web/Scotty/Types.hs b/Web/Scotty/Types.hs --- a/Web/Scotty/Types.hs +++ b/Web/Scotty/Types.hs @@ -10,7 +10,6 @@ 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 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 @@ | 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 @@ 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 @@ 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 @@ | Literal Text | Function (Request -> Maybe [Param]) -instance IsString RoutePattern where +instance IsString RoutePattern where fromString = Capture . pack diff --git a/Web/Scotty/Util.hs b/Web/Scotty/Util.hs --- a/Web/Scotty/Util.hs +++ b/Web/Scotty/Util.hs @@ -34,11 +34,14 @@ 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 diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,6 +1,17 @@ +## 0.8.0 + +* Upgrade to wai/wai-extra/warp 3.0 + +* No longer depend on conduit-extra. + +* The `source` response method has been deprecated in favor + of a new `stream` response, matching changes in WAI 3.0. + +* Removed the deprecated `reqHeader` function. + ## 0.7.3 -* Bump upper bound for `case-insensitive`, `mtl` and `transformers`. +* Bump upper bound for case-insensitive, mtl and transformers. ## 0.7.2 @@ -65,7 +76,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` diff --git a/scotty.cabal b/scotty.cabal --- a/scotty.cabal +++ b/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 @@ -74,18 +74,31 @@ 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 + +test-suite spec + main-is: Spec.hs + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: test + build-depends: base, + bytestring, + http-types, + wai, + hspec >= 1.9.2, + wai-extra >= 3.0.0, + scotty + GHC-options: -Wall -fno-warn-orphans source-repository head type: git diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}