scotty 0.12 → 0.12.1
raw patch · 10 files changed
+149/−42 lines, 10 filesdep ~aesondep ~base-compat-batteriesdep ~mtlnew-uploader
Dependency ranges changed: aeson, base-compat-batteries, mtl, text, transformers
Files
- README.md +17/−0
- Web/Scotty.hs +9/−3
- Web/Scotty/Action.hs +5/−2
- Web/Scotty/Internal/Types.hs +30/−6
- Web/Scotty/Route.hs +18/−14
- Web/Scotty/Trans.hs +9/−2
- Web/Scotty/Util.hs +21/−0
- changelog.md +10/−0
- scotty.cabal +18/−13
- test/Web/ScottySpec.hs +12/−2
README.md view
@@ -40,3 +40,20 @@ Open an issue on GitHub. Copyright (c) 2012-2019 Andrew Farmer++### FAQ++* Fails to compile regex-posix on Windows+ * If you are using stack, add the following parameters to `stack.yaml`:+ * ```yaml+ extra-deps:+ - regex-posix-clib-2.7+ flags:+ regex-posix:+ _regex-posix-clib: true+ ```+ * If you are using cabal, update the `constraints` section of `cabal.project.local` as follows:+ * ```+ constraints:+ regex-posix +_regex-posix-clib + ```
Web/Scotty.hs view
@@ -13,7 +13,7 @@ -- | 'Middleware' and routes are run in the order in which they -- are defined. All middleware is run first, followed by the first -- route that matches. If no route matches, a 404 response is given.- , middleware, get, post, put, delete, patch, options, addroute, matchAny, notFound+ , middleware, get, post, put, delete, patch, options, addroute, matchAny, notFound, setMaxRequestBodySize -- ** Route Patterns , capture, regex, function, literal -- ** Accessing the Request, Captures, and Query Parameters@@ -30,7 +30,7 @@ -- * Parsing Parameters , Param, Trans.Parsable(..), Trans.readEither -- * Types- , ScottyM, ActionM, RoutePattern, File+ , ScottyM, ActionM, RoutePattern, File, Kilobytes ) where -- With the exception of this, everything else better just import types.@@ -46,7 +46,7 @@ import Network.Wai (Application, Middleware, Request, StreamingBody) import Network.Wai.Handler.Warp (Port) -import Web.Scotty.Internal.Types (ScottyT, ActionT, Param, RoutePattern, Options, File)+import Web.Scotty.Internal.Types (ScottyT, ActionT, Param, RoutePattern, Options, File, Kilobytes) type ScottyM = ScottyT Text IO type ActionM = ActionT Text IO@@ -88,6 +88,12 @@ -- on the response). Every middleware is run on each request. middleware :: Middleware -> ScottyM () middleware = Trans.middleware++-- | Set global size limit for the request body. Requests with body size exceeding the limit will not be+-- processed and an HTTP response 413 will be returned to the client. Size limit needs to be greater than 0, +-- otherwise the application will terminate on start. +setMaxRequestBodySize :: Kilobytes -> ScottyM ()+setMaxRequestBodySize = Trans.setMaxRequestBodySize -- | Throw an exception, which can be caught with 'rescue'. Uncaught exceptions -- turn into HTTP 500 responses.
Web/Scotty/Action.hs view
@@ -37,8 +37,10 @@ import Blaze.ByteString.Builder (fromLazyByteString) import qualified Control.Exception as E+import Control.Monad (liftM, when) import Control.Monad.Error.Class-import Control.Monad.Reader hiding (mapM)+import Control.Monad.IO.Class (MonadIO(..))+import Control.Monad.Reader (MonadReader(..), ReaderT(..)) import qualified Control.Monad.State.Strict as MS import Control.Monad.Trans.Except @@ -333,7 +335,8 @@ raw $ encodeUtf8 t -- | Send a file as the response. Doesn't set the \"Content-Type\" header, so you probably--- want to do that on your own with 'setHeader'.+-- want to do that on your own with 'setHeader'. Setting a status code will have no effect+-- because Warp will overwrite that to 200 (see 'Network.Wai.Handler.Warp.Internal.sendResponse'). file :: Monad m => FilePath -> ActionT e m () file = ActionT . MS.modify . setContent . ContentFile
Web/Scotty/Internal/Types.hs view
@@ -5,18 +5,25 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE RecordWildCards #-}+ module Web.Scotty.Internal.Types where import Blaze.ByteString.Builder (Builder) import Control.Applicative+import Control.Exception (Exception) import qualified Control.Exception as E+import qualified Control.Monad as Monad+import Control.Monad (MonadPlus(..)) import Control.Monad.Base (MonadBase, liftBase, liftBaseDefault) import Control.Monad.Catch (MonadCatch, catch, MonadThrow, throwM) import Control.Monad.Error.Class import qualified Control.Monad.Fail as Fail-import Control.Monad.Reader-import Control.Monad.State.Strict+import Control.Monad.IO.Class (MonadIO)+import Control.Monad.Reader (MonadReader(..), ReaderT, mapReaderT)+import Control.Monad.State.Strict (MonadState(..), State, StateT, mapStateT)+import Control.Monad.Trans.Class (MonadTrans(..)) import Control.Monad.Trans.Control (MonadBaseControl, StM, liftBaseWith, restoreM, ComposeSt, defaultLiftBaseWith, defaultRestoreM, MonadTransControl, StT, liftWith, restoreT) import Control.Monad.Trans.Except @@ -51,6 +58,13 @@ instance Default Options where def = Options 1 defaultSettings +newtype RouteOptions = RouteOptions { maxRequestBodySize :: Maybe Kilobytes -- max allowed request size in KB+ }++instance Default RouteOptions where+ def = RouteOptions Nothing++type Kilobytes = Int ----- Transformer Aware Applications/Middleware ----- type Middleware m = Application m -> Application m type Application m = Request -> m Response@@ -60,10 +74,11 @@ ScottyState { middlewares :: [Wai.Middleware] , routes :: [Middleware m] , handler :: ErrorHandler e m+ , routeOptions :: RouteOptions } instance Default (ScottyState e m) where- def = ScottyState [] [] Nothing+ def = ScottyState [] [] Nothing def addMiddleware :: Wai.Middleware -> ScottyState e m -> ScottyState e m addMiddleware m s@(ScottyState {middlewares = ms}) = s { middlewares = m:ms }@@ -74,6 +89,11 @@ addHandler :: ErrorHandler e m -> ScottyState e m -> ScottyState e m addHandler h s = s { handler = h } +updateMaxRequestBodySize :: RouteOptions -> ScottyState e m -> ScottyState e m+updateMaxRequestBodySize RouteOptions { .. } s@ScottyState { routeOptions = ro } =+ let ro' = ro { maxRequestBodySize = maxRequestBodySize }+ in s { routeOptions = ro' }+ newtype ScottyT e m a = ScottyT { runS :: State (ScottyState e m) a } deriving ( Functor, Applicative, Monad ) @@ -104,6 +124,10 @@ type ErrorHandler e m = Maybe (e -> ActionT e m ()) +data ScottyException = RequestException BS.ByteString Status deriving (Show, Typeable)++instance Exception ScottyException+ ------------------ Scotty Actions ------------------- type Param = (Text, Text) @@ -139,7 +163,7 @@ newtype ActionT e m a = ActionT { runAM :: ExceptT (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a } deriving ( Functor, Applicative, MonadIO ) -instance (Monad m, ScottyError e) => Monad (ActionT e m) where+instance (Monad m, ScottyError e) => Monad.Monad (ActionT e m) where return = ActionT . return ActionT m >>= k = ActionT (m >>= runAM . k) #if !(MIN_VERSION_base(4,13,0))@@ -165,7 +189,7 @@ Left _ -> runExceptT n Right r -> return $ Right r -instance MonadTrans (ActionT e) where+instance ScottyError e => MonadTrans (ActionT e) where lift = ActionT . lift . lift . lift instance (ScottyError e, Monad m) => MonadError (ActionError e) (ActionT e m) where@@ -184,7 +208,7 @@ instance (MonadCatch m, ScottyError e) => MonadCatch (ActionT e m) where catch (ActionT m) f = ActionT (m `catch` (runAM . f)) -instance MonadTransControl (ActionT e) where+instance ScottyError e => MonadTransControl (ActionT e) where type StT (ActionT e) a = StT (StateT ScottyResponse) (StT (ReaderT ActionEnv) (StT (ExceptT (ActionError e)) a)) liftWith = \f -> ActionT $ liftWith $ \run ->
Web/Scotty/Route.hs view
@@ -4,22 +4,24 @@ ( get, post, put, delete, patch, options, addroute, matchAny, notFound, capture, regex, function, literal ) where-+ +import Blaze.ByteString.Builder (fromByteString) import Control.Arrow ((***)) import Control.Concurrent.MVar-import Control.Exception (throw)+import Control.Exception (throw, catch) import Control.Monad.IO.Class import qualified Control.Monad.State as MS import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as BL+ import Data.Maybe (fromMaybe, isJust) import Data.String (fromString) import qualified Data.Text.Lazy as T import qualified Data.Text as TS import Network.HTTP.Types-import Network.Wai (Request(..))+import Network.Wai (Request(..), Response, responseBuilder) #if MIN_VERSION_wai(3,2,2) import Network.Wai.Internal (getRequestBodyChunk) #endif@@ -60,7 +62,7 @@ -- | Add a route that matches regardless of the HTTP verb. matchAny :: (ScottyError e, MonadIO m) => RoutePattern -> ActionT e m () -> ScottyT e m ()-matchAny pattern action = ScottyT $ MS.modify $ \s -> addRoute (route (handler s) Nothing pattern action) s+matchAny pattern action = ScottyT $ MS.modify $ \s -> addRoute (route (routeOptions s) (handler s) Nothing pattern action) s -- | Specify an action to take if nothing else is found. Note: this _always_ matches, -- so should generally be the last route specified.@@ -82,10 +84,10 @@ -- >>> curl http://localhost:3000/foo/something -- something addroute :: (ScottyError e, MonadIO m) => StdMethod -> RoutePattern -> ActionT e m () -> ScottyT e m ()-addroute method pat action = ScottyT $ MS.modify $ \s -> addRoute (route (handler s) (Just method) pat action) s+addroute method pat action = ScottyT $ MS.modify $ \s -> addRoute (route (routeOptions s) (handler s) (Just method) pat action) s -route :: (ScottyError e, MonadIO m) => ErrorHandler e m -> Maybe StdMethod -> RoutePattern -> ActionT e m () -> Middleware m-route h method pat action app req =+route :: (ScottyError e, MonadIO m) => RouteOptions -> ErrorHandler e m -> Maybe StdMethod -> RoutePattern -> ActionT e m () -> Middleware m+route opts h method pat action app req = let tryNext = app req {- | We match all methods in the case where 'method' is 'Nothing'.@@ -99,12 +101,16 @@ in if methodMatches then case matchRoute pat req of Just captures -> do- env <- mkEnv req captures- res <- runAction h env action+ env <- liftIO $ catch (Right <$> mkEnv req captures opts) (\ex -> return . Left $ ex)+ res <- evalAction h env action maybe tryNext return res Nothing -> tryNext else tryNext +evalAction :: (ScottyError e, Monad m) => ErrorHandler e m -> (Either ScottyException ActionEnv) -> ActionT e m () -> m (Maybe Response)+evalAction _ (Left (RequestException msg s)) _ = return . Just $ responseBuilder s [("Content-Type","text/html")] $ fromByteString msg+evalAction h (Right env) action = runAction h env action+ matchRoute :: RoutePattern -> Request -> Maybe [Param] matchRoute (Literal pat) req | pat == path req = Just [] | otherwise = Nothing@@ -147,13 +153,11 @@ (b:bs) -> return (bs, b) liftIO $ Parse.sinkRequestBody s rbt provider -mkEnv :: forall m. MonadIO m => Request -> [Param] -> m ActionEnv-mkEnv req captures = do+mkEnv :: forall m. MonadIO m => Request -> [Param] -> RouteOptions ->m ActionEnv+mkEnv req captures opts = do bodyState <- liftIO $ newMVar BodyUntouched let rbody = getRequestBodyChunk req- takeAll :: ([B.ByteString] -> IO [B.ByteString]) -> IO [B.ByteString]- takeAll prefix = rbody >>= \b -> if B.null b then prefix [] else takeAll (prefix . (b:)) safeBodyReader :: IO B.ByteString safeBodyReader = do@@ -178,7 +182,7 @@ return b BodyCorrupted -> throw BodyPartiallyStreamed BodyUntouched ->- do chunks <- takeAll return+ do chunks <- readRequestBody rbody return (maxRequestBodySize opts) let b = BL.fromChunks chunks putMVar bodyState $ BodyCached b chunks return b
Web/Scotty/Trans.hs view
@@ -17,7 +17,7 @@ -- | 'Middleware' and routes are run in the order in which they -- are defined. All middleware is run first, followed by the first -- route that matches. If no route matches, a 404 response is given.- , middleware, get, post, put, delete, patch, options, addroute, matchAny, notFound+ , middleware, get, post, put, delete, patch, options, addroute, matchAny, notFound, setMaxRequestBodySize -- ** Route Patterns , capture, regex, function, literal -- ** Accessing the Request, Captures, and Query Parameters@@ -34,13 +34,14 @@ -- * Parsing Parameters , Param, Parsable(..), readEither -- * Types- , RoutePattern, File+ , RoutePattern, File, Kilobytes -- * Monad Transformers , ScottyT, ActionT ) where import Blaze.ByteString.Builder (fromByteString) +import Control.Exception (assert) import Control.Monad (when) import Control.Monad.State.Strict (execState, modify) import Control.Monad.IO.Class@@ -127,3 +128,9 @@ -- on the response). Every middleware is run on each request. middleware :: Middleware -> ScottyT e m () middleware = ScottyT . modify . addMiddleware++-- | Set global size limit for the request body. Requests with body size exceeding the limit will not be+-- processed and an HTTP response 413 will be returned to the client. Size limit needs to be greater than 0, +-- otherwise the application will terminate on start. +setMaxRequestBodySize :: Kilobytes -> ScottyT e m ()+setMaxRequestBodySize i = assert (i > 0) $ ScottyT . modify . updateMaxRequestBodySize $ def { maxRequestBodySize = Just i }
Web/Scotty/Util.hs view
@@ -9,14 +9,19 @@ , add , addIfNotPresent , socketDescription+ , readRequestBody ) where import Network.Socket (SockAddr(..), Socket, getSocketName, socketPort) import Network.Wai +import Control.Monad (when)+import Control.Exception (throw)+ import Network.HTTP.Types import qualified Data.ByteString as B+import qualified Data.Text as TP (pack) import qualified Data.Text.Lazy as T import qualified Data.Text.Encoding as ES import qualified Data.Text.Encoding.Error as ES@@ -70,3 +75,19 @@ case sockName of SockAddrUnix u -> return $ "unix socket " ++ u _ -> fmap (\port -> "port " ++ show port) $ socketPort sock++-- return request body or throw an exception if request body too big+readRequestBody :: IO B.ByteString -> ([B.ByteString] -> IO [B.ByteString]) -> Maybe Kilobytes ->IO [B.ByteString]+readRequestBody rbody prefix maxSize = do+ b <- rbody+ if B.null b then+ prefix []+ else+ do+ checkBodyLength maxSize + readRequestBody rbody (prefix . (b:)) maxSize+ where checkBodyLength :: Maybe Kilobytes -> IO ()+ checkBodyLength (Just maxSize') = prefix [] >>= \bodySoFar -> when (isBigger bodySoFar maxSize') readUntilEmpty+ checkBodyLength Nothing = return ()+ isBigger bodySoFar maxSize' = (B.length . B.concat $ bodySoFar) > maxSize' * 1024+ readUntilEmpty = rbody >>= \b -> if B.null b then throw (RequestException (ES.encodeUtf8 . TP.pack $ "Request is too big Jim!") status413) else readUntilEmpty
changelog.md view
@@ -1,3 +1,13 @@+## next [????.??.??]++## 0.12.1 [2022.11.17]+* Fix CPP bug that prevented tests from building on Windows.+* Allow building with `transformers-0.6.*` and `mtl-2.3.*`. Because the+ `MonadTrans t` class gained a `forall m. Monad m => Monad (t m)` superclass+ in `transformers-0.6.0.0`, the `MonadTrans` and `MonadTransControl` instances+ for `ActionT e` now have a `ScottyError e` instance context to match the+ `Monad` instance.+ ## 0.12 [2020.05.16] * Provide `MonadReader` and `MonadState` instances for `ActionT`. * Add HTTP Status code as a field to `ActionError`, and add
scotty.cabal view
@@ -1,5 +1,5 @@ Name: scotty-Version: 0.12+Version: 0.12.1 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@@ -51,8 +51,9 @@ , GHC == 8.2.2 , GHC == 8.4.4 , GHC == 8.6.5- , GHC == 8.8.3- , GHC == 8.10.1+ , GHC == 8.8.4+ , GHC == 8.10.4+ , GHC == 9.0.1 Extra-source-files: README.md changelog.md@@ -71,28 +72,32 @@ Web.Scotty.Route Web.Scotty.Util default-language: Haskell2010- build-depends: aeson >= 0.6.2.1 && < 1.5,+ build-depends: aeson >= 0.6.2.1 && < 2.2, base >= 4.6 && < 5,- base-compat-batteries >= 0.10 && < 0.12,+ base-compat-batteries >= 0.10 && < 0.13, blaze-builder >= 0.3.3.0 && < 0.5,- bytestring >= 0.10.0.2 && < 0.11,+ bytestring >= 0.10.0.2 && < 0.12, case-insensitive >= 1.0.0.1 && < 1.3, data-default-class >= 0.0.1 && < 0.2, exceptions >= 0.7 && < 0.11,- fail, http-types >= 0.9.1 && < 0.13, monad-control >= 1.0.0.3 && < 1.1,- mtl >= 2.1.2 && < 2.3,- nats >= 0.1 && < 2,+ mtl >= 2.1.2 && < 2.4, network >= 2.6.0.2 && < 3.2, regex-compat >= 0.95.1 && < 0.96,- text >= 0.11.3.1 && < 1.3,- transformers >= 0.3.0.0 && < 0.6,+ text >= 0.11.3.1 && < 2.1,+ transformers >= 0.3.0.0 && < 0.7, transformers-base >= 0.4.1 && < 0.5,- transformers-compat >= 0.4 && < 0.7,+ transformers-compat >= 0.4 && < 0.8, wai >= 3.0.0 && < 3.3,- wai-extra >= 3.0.0 && < 3.1,+ wai-extra >= 3.0.0 && < 3.2, warp >= 3.0.13 && < 3.4++ if impl(ghc < 8.0)+ build-depends: fail++ if impl(ghc < 7.10)+ build-depends: nats >= 0.1 && < 2 GHC-options: -Wall -fno-warn-orphans
test/Web/ScottySpec.hs view
@@ -8,6 +8,8 @@ import Control.Monad import Data.Char import Data.String+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TLE import Network.HTTP.Types import qualified Control.Exception.Lifted as EL import qualified Control.Exception as E@@ -34,6 +36,7 @@ spec :: Spec spec = do+ let withApp = with . scottyApp describe "ScottyM" $ do forM_ [ ("GET", Scotty.get, get)@@ -115,6 +118,15 @@ it "replaces non UTF-8 bytes with Unicode replacement character" $ do request "POST" "/search" [("Content-Type","application/x-www-form-urlencoded")] "query=\xe9" `shouldRespondWith` "\xfffd" ++ describe "requestLimit" $ do+ withApp (Scotty.setMaxRequestBodySize 1 >> Scotty.matchAny "/upload" (do status status200)) $ do+ it "upload endpoint for max-size requests, status 413 if request is too big, 200 otherwise" $ do+ request "POST" "/upload" [("Content-Type","multipart/form-data; boundary=--33")]+ (TLE.encodeUtf8 . TL.pack . concat $ [show c | c <- ([1..4500]::[Integer])]) `shouldRespondWith` 413+ request "POST" "/upload" [("Content-Type","multipart/form-data; boundary=--33")]+ (TLE.encodeUtf8 . TL.pack . concat $ [show c | c <- ([1..50]::[Integer])]) `shouldRespondWith` 200+ describe "text" $ do let modernGreekText :: IsString a => a modernGreekText = "νέα ελληνικά"@@ -174,8 +186,6 @@ where ok, no :: ByteString ok = "HTTP/1.1 200 OK" no = "HTTP/1.1 404 Not Found"-- withApp = with . scottyApp socketPath :: FilePath socketPath = "/tmp/scotty-test.socket"