scotty 0.20.1 → 0.21
raw patch · 21 files changed
+903/−352 lines, 21 filesdep +doctestdep +http-clientdep ~basedep ~bytestringdep ~http-types
Dependencies added: doctest, http-client
Dependency ranges changed: base, bytestring, http-types, text, wai, warp
Files
- README.md +35/−6
- Web/Scotty.hs +192/−70
- Web/Scotty/Action.hs +227/−92
- Web/Scotty/Body.hs +2/−2
- Web/Scotty/Cookie.hs +8/−6
- Web/Scotty/Exceptions.hs +0/−25
- Web/Scotty/Internal/Types.hs +31/−32
- Web/Scotty/Route.hs +80/−59
- Web/Scotty/Trans.hs +44/−24
- Web/Scotty/Trans/Lazy.hs +61/−0
- Web/Scotty/Trans/Strict.hs +56/−0
- Web/Scotty/Util.hs +11/−9
- changelog.md +23/−1
- doctest/Main.hs +23/−0
- examples/basic.hs +17/−7
- examples/cookies.hs +2/−2
- examples/exceptions.hs +9/−4
- examples/upload.hs +2/−1
- examples/urlshortener.hs +1/−1
- scotty.cabal +21/−4
- test/Web/ScottySpec.hs +58/−7
README.md view
@@ -8,7 +8,7 @@ main = scotty 3000 $ get "/:word" $ do- beam <- captureParam "word"+ beam <- pathParam "word" html $ mconcat ["<h1>Scotty, ", beam, " me up!</h1>"] ``` @@ -19,15 +19,44 @@ * Conforms to the [web application interface (WAI)](https://github.com/yesodweb/wai/). * Uses the very fast Warp webserver by default. -See examples/basic.hs to see Scotty in action. (basic.hs needs the wai-extra package)+As for the name: Sinatra + Warp = Scotty. +## Examples++Run /basic.hs to see Scotty in action:+ ```bash-> runghc examples/basic.hs-Setting phasers to stun... (port 3000) (ctrl-c to quit)-(visit localhost:3000/somepath)+runghc examples/basic.hs ```+`Setting phasers to stun... (port 3000) (ctrl-c to quit)` -As for the name: Sinatra + Warp = Scotty.+Or equivalently with [`stack`](https://docs.haskellstack.org/en/stable/):++```bash+stack exec -- scotty-basic+```++Once the server is running you can interact with it with curl or a browser:++```bash+curl localhost:3000+```+`foobar`++```bash+curl localhost:3000/foo_query?p=42+```+`<h1>42</h1>`+++Additionally, the `examples` directory shows a number of concrete use cases, e.g. ++* [exception handling](./examples/exceptions.hs)+* [global state](./examples/globalstate.hs)+* [configuration](./examples/reader.hs)+* [cookies](./examples/cookies.hs)+* [file upload](./examples/upload.hs)+* and more ## More Information
Web/Scotty.hs view
@@ -5,9 +5,16 @@ -- Scotty is set up by default for development mode. For production servers, -- you will likely want to modify 'Trans.settings' and the 'defaultHandler'. See -- the comments on each of these functions for more information.+--+-- Please refer to the @examples@ directory and the @spec@ test suite for concrete use cases, e.g. constructing responses, exception handling and useful implementation details. module Web.Scotty- ( -- * scotty-to-WAI- scotty, scottyApp, scottyOpts, scottySocket, Options(..), defaultOptions+ ( -- * Running 'scotty' servers+ scotty+ , scottyOpts+ , scottySocket+ , Options(..), defaultOptions+ -- ** scotty-to-WAI+ , scottyApp -- * Defining Middleware and Routes -- -- | 'Middleware' and routes are run in the order in which they@@ -16,12 +23,14 @@ , middleware, get, post, put, delete, patch, options, addroute, matchAny, notFound, nested, setMaxRequestBodySize -- ** Route Patterns , capture, regex, function, literal- -- ** Accessing the Request, Captures, and Query Parameters+ -- ** Accessing the Request and its fields , request, header, headers, body, bodyReader- , param, params- , captureParam, formParam, queryParam- , captureParams, formParams, queryParams , jsonData, files+ -- ** Accessing Path, Form and Query Parameters+ , param, params+ , pathParam, captureParam, formParam, queryParam+ , pathParamMaybe, captureParamMaybe, formParamMaybe, queryParamMaybe+ , pathParams, captureParams, formParams, queryParams -- ** Modifying the Response and Redirecting , status, addHeader, setHeader, redirect -- ** Setting Response Body@@ -29,32 +38,65 @@ -- | 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, stream, raw+ -- ** Accessing the fields of the Response+ , getResponseHeaders, getResponseStatus, getResponseContent -- ** Exceptions , raise, raiseStatus, throw, rescue, next, finish, defaultHandler, liftAndCatchIO+ , liftIO, catch , StatusError(..)+ , ScottyException(..) -- * Parsing Parameters , Param, Trans.Parsable(..), Trans.readEither -- * Types- , ScottyM, ActionM, RoutePattern, File, Kilobytes, Handler(..)+ , ScottyM, ActionM, RoutePattern, File, Content(..), Kilobytes, ErrorHandler, Handler(..) , ScottyState, defaultScottyState ) where import qualified Web.Scotty.Trans as Trans import qualified Control.Exception as E+import Control.Monad.IO.Class import Data.Aeson (FromJSON, ToJSON) import qualified Data.ByteString as BS import Data.ByteString.Lazy.Char8 (ByteString)-import Data.Text.Lazy (Text)+import Data.Text.Lazy (Text, toStrict) -import Network.HTTP.Types (Status, StdMethod)+import Network.HTTP.Types (Status, StdMethod, ResponseHeaders) import Network.Socket (Socket) import Network.Wai (Application, Middleware, Request, StreamingBody) import Network.Wai.Handler.Warp (Port) -import Web.Scotty.Internal.Types (ScottyT, ActionT, ErrorHandler, Param, RoutePattern, Options, defaultOptions, File, Kilobytes, ScottyState, defaultScottyState, StatusError(..))-import Web.Scotty.Exceptions (Handler(..))+import Web.Scotty.Internal.Types (ScottyT, ActionT, ErrorHandler, Param, RoutePattern, Options, defaultOptions, File, Kilobytes, ScottyState, defaultScottyState, ScottyException, StatusError(..), Content(..))+import UnliftIO.Exception (Handler(..), catch) +{- $setup+>>> :{+import Control.Monad.IO.Class (MonadIO(..))+import qualified Network.HTTP.Client as H+import qualified Network.HTTP.Types as H+import qualified Network.Wai as W (httpVersion)+import qualified Data.ByteString.Lazy.Char8 as LBS (unpack)+import qualified Data.Text as T (pack)+import Control.Concurrent (ThreadId, forkIO, killThread)+import Control.Exception (bracket)+import qualified Web.Scotty as S (ScottyM, scottyOpts, get, text, regex, pathParam, Options(..), defaultOptions)+-- | GET an HTTP path+curl :: MonadIO m =>+ String -- ^ path+ -> m String -- ^ response body+curl path = liftIO $ do+ req0 <- H.parseRequest path+ let req = req0 { H.method = "GET"}+ mgr <- H.newManager H.defaultManagerSettings+ (LBS.unpack . H.responseBody) <$> H.httpLbs req mgr+-- | Fork a process, run a Scotty server in it and run an action while the server is running. Kills the scotty thread once the inner action is done.+withScotty :: S.ScottyM ()+ -> IO a -- ^ inner action, e.g. 'curl "localhost:3000/"'+ -> IO a+withScotty serv act = bracket (forkIO $ S.scottyOpts (S.defaultOptions{ S.verbose = 0 }) serv) killThread (\_ -> act)+:}+-}+ type ScottyM = ScottyT IO type ActionM = ActionT IO @@ -104,19 +146,21 @@ setMaxRequestBodySize :: Kilobytes -> ScottyM () setMaxRequestBodySize = Trans.setMaxRequestBodySize --- | Throw a "500 Server Error" 'StatusError', which can be caught with 'rescue'.+-- | Throw a "500 Server Error" 'StatusError', which can be caught with 'catch'. -- -- Uncaught exceptions turn into HTTP 500 responses. raise :: Text -> ActionM a raise = Trans.raise+{-# DEPRECATED raise "Throw an exception instead" #-} --- | Throw a 'StatusError' exception that has an associated HTTP error code and can be caught with 'rescue'.+-- | Throw a 'StatusError' exception that has an associated HTTP error code and can be caught with 'catch'. -- -- Uncaught exceptions turn into HTTP responses corresponding to the given status. raiseStatus :: Status -> Text -> ActionM a raiseStatus = Trans.raiseStatus+{-# DEPRECATED raiseStatus "Use status, text, and finish instead" #-} --- | Throw an exception which can be caught within the scope of the current Action with 'rescue' or 'catch'.+-- | Throw an exception which can be caught within the scope of the current Action with 'catch'. -- -- If the exception is not caught locally, another option is to implement a global 'Handler' (with 'defaultHandler') that defines its interpretation and a translation to HTTP error codes. --@@ -134,12 +178,12 @@ -- ever run is if the first one calls 'next'. -- -- > get "/foo/:bar" $ do--- > w :: Text <- captureParam "bar"+-- > w :: Text <- pathParam "bar" -- > unless (w == "special") next -- > text "You made a request to /foo/special" -- > -- > get "/foo/:baz" $ do--- > w <- captureParam "baz"+-- > w <- pathParam "baz" -- > text $ "You made a request to: " <> w next :: ActionM () next = Trans.next@@ -151,7 +195,7 @@ -- content the text message. -- -- > get "/foo/:bar" $ do--- > w :: Text <- captureParam "bar"+-- > w :: Text <- pathParam "bar" -- > unless (w == "special") finish -- > text "You made a request to /foo/special" --@@ -161,13 +205,15 @@ -- | Catch an exception e.g. a 'StatusError' or a user-defined exception. ----- > raise JustKidding `rescue` (\msg -> text msg)+-- > raise JustKidding `catch` (\msg -> text msg) rescue :: E.Exception e => ActionM a -> (e -> ActionM a) -> ActionM a rescue = Trans.rescue+{-# DEPRECATED rescue "Use catch instead" #-} -- | Like 'liftIO', but catch any IO exceptions and turn them into Scotty exceptions. liftAndCatchIO :: IO a -> ActionM a liftAndCatchIO = Trans.liftAndCatchIO+{-# DEPRECATED liftAndCatchIO "Use liftIO instead" #-} -- | Redirect to given URL. Like throwing an uncatchable exception. Any code after the call to redirect -- will not be run.@@ -212,47 +258,97 @@ -- | Get a parameter. First looks in captures, then form data, then query parameters. ----- * Raises an exception which can be caught by 'rescue' if parameter is not found.+-- * Raises an exception which can be caught by 'catch' if parameter is not found. -- -- * If parameter is found, but 'parseParam' fails to parse to the correct type, 'next' is called. -- This means captures are somewhat typed, in that a route won't match if a correctly typed -- capture cannot be parsed. param :: Trans.Parsable a => Text -> ActionM a-param = Trans.param-{-# DEPRECATED param "(#204) Not a good idea to treat all parameters identically. Use captureParam, formParam and queryParam instead. "#-}+param = Trans.param . toStrict+{-# DEPRECATED param "(#204) Not a good idea to treat all parameters identically. Use pathParam, formParam and queryParam instead. "#-} --- | Get a capture parameter.+-- | Synonym for 'pathParam' ----- * Raises an exception which can be caught by 'rescue' if parameter is not found. If the exception is not caught, scotty will return a HTTP error code 500 ("Internal Server Error") to the client.+-- /Since: 0.20/+captureParam :: Trans.Parsable a => Text -> ActionM a+captureParam = Trans.captureParam . toStrict++-- | Get a path parameter. --+-- * Raises an exception which can be caught by 'catch' if parameter is not found. If the exception is not caught, scotty will return a HTTP error code 500 ("Internal Server Error") to the client.+-- -- * If the parameter is found, but 'parseParam' fails to parse to the correct type, 'next' is called.-captureParam :: Trans.Parsable a => Text -> ActionM a-captureParam = Trans.captureParam+--+-- /Since: 0.21/+pathParam :: Trans.Parsable a => Text -> ActionM a+pathParam = Trans.pathParam . toStrict -- | Get a form parameter. ----- * Raises an exception which can be caught by 'rescue' if parameter is not found. If the exception is not caught, scotty will return a HTTP error code 400 ("Bad Request") to the client.+-- * Raises an exception which can be caught by 'catch' if parameter is not found. If the exception is not caught, scotty will return a HTTP error code 400 ("Bad Request") to the client. -- -- * This function raises a code 400 also if the parameter is found, but 'parseParam' fails to parse to the correct type.+--+-- /Since: 0.20/ formParam :: Trans.Parsable a => Text -> ActionM a-formParam = Trans.formParam+formParam = Trans.formParam . toStrict -- | Get a query parameter. ----- * Raises an exception which can be caught by 'rescue' if parameter is not found. If the exception is not caught, scotty will return a HTTP error code 400 ("Bad Request") to the client.+-- * Raises an exception which can be caught by 'catch' if parameter is not found. If the exception is not caught, scotty will return a HTTP error code 400 ("Bad Request") to the client. -- -- * This function raises a code 400 also if the parameter is found, but 'parseParam' fails to parse to the correct type.+--+-- /Since: 0.20/ queryParam :: Trans.Parsable a => Text -> ActionM a-queryParam = Trans.queryParam+queryParam = Trans.queryParam . toStrict --- | Get all parameters from capture, form and query (in that order).++-- | Look up a path parameter. Returns 'Nothing' if the parameter is not found or cannot be parsed at the right type.+--+-- NB : Doesn't throw exceptions. In particular, route pattern matching will not continue, so developers+-- must 'raiseStatus' or 'throw' to signal something went wrong.+--+-- /Since: 0.21/+pathParamMaybe :: (Trans.Parsable a) => Text -> ActionM (Maybe a)+pathParamMaybe = Trans.pathParamMaybe . toStrict++-- | Synonym for 'pathParamMaybe'+--+-- /Since: 0.21/+captureParamMaybe :: (Trans.Parsable a) => Text -> ActionM (Maybe a)+captureParamMaybe = Trans.pathParamMaybe . toStrict++-- | Look up a form parameter. Returns 'Nothing' if the parameter is not found or cannot be parsed at the right type.+--+-- NB : Doesn't throw exceptions, so developers must 'raiseStatus' or 'throw' to signal something went wrong.+--+-- /Since: 0.21/+formParamMaybe :: (Trans.Parsable a) => Text -> ActionM (Maybe a)+formParamMaybe = Trans.formParamMaybe . toStrict++-- | Look up a query parameter. Returns 'Nothing' if the parameter is not found or cannot be parsed at the right type.+--+-- NB : Doesn't throw exceptions, so developers must 'raiseStatus' or 'throw' to signal something went wrong.+--+-- /Since: 0.21/+queryParamMaybe :: (Trans.Parsable a) => Text -> ActionM (Maybe a)+queryParamMaybe = Trans.queryParamMaybe . toStrict+++++-- | Get all parameters from path, form and query (in that order). params :: ActionM [Param] params = Trans.params-{-# DEPRECATED params "(#204) Not a good idea to treat all parameters identically. Use captureParams, formParams and queryParams instead. "#-}+{-# DEPRECATED params "(#204) Not a good idea to treat all parameters identically. Use pathParams, formParams and queryParams instead. "#-} --- | Get capture parameters+-- | Synonym for 'pathParams' captureParams :: ActionM [Param] captureParams = Trans.captureParams+-- | Get path parameters+pathParams :: ActionM [Param]+pathParams = Trans.pathParams -- | Get form parameters formParams :: ActionM [Param] formParams = Trans.formParams@@ -305,6 +401,24 @@ raw :: ByteString -> ActionM () raw = Trans.raw ++-- | Access the HTTP 'Status' of the Response+--+-- /Since: 0.21/+getResponseStatus :: ActionM Status+getResponseStatus = Trans.getResponseStatus+-- | Access the HTTP headers of the Response+--+-- /Since: 0.21/+getResponseHeaders :: ActionM ResponseHeaders+getResponseHeaders = Trans.getResponseHeaders+-- | Access the content of the Response+--+-- /Since: 0.21/+getResponseContent :: ActionM Content+getResponseContent = Trans.getResponseContent++ -- | get = 'addroute' 'GET' get :: RoutePattern -> ActionM () -> ScottyM () get = Trans.get@@ -338,35 +452,37 @@ notFound :: ActionM () -> ScottyM () notFound = Trans.notFound --- | Define a route with a 'StdMethod', 'Text' value representing the path spec,--- and a body ('Action') which modifies the response.------ > addroute GET "/" $ text "beam me up!"------ The path spec can include values starting with a colon, which are interpreted--- as /captures/. These are named wildcards that can be looked up with 'param'.------ > addroute GET "/foo/:bar" $ do--- > v <- param "bar"--- > text v------ >>> curl http://localhost:3000/foo/something--- something+{- | Define a route with a 'StdMethod', a route pattern representing the path spec,+and an 'Action' which may modify the response.++> get "/" $ text "beam me up!"++The path spec can include values starting with a colon, which are interpreted+as /captures/. These are parameters that can be looked up with 'pathParam'.++>>> :{+let server = S.get "/foo/:bar" (S.pathParam "bar" >>= S.text)+ in do+ withScotty server $ curl "http://localhost:3000/foo/something"+:}+"something"+-} addroute :: StdMethod -> RoutePattern -> ActionM () -> ScottyM () addroute = Trans.addroute --- | Match requests using a regular expression.--- Named captures are not yet supported.------ > get (regex "^/f(.*)r$") $ do--- > path <- param "0"--- > cap <- param "1"--- > text $ mconcat ["Path: ", path, "\nCapture: ", cap]------ >>> curl http://localhost:3000/foo/bar--- Path: /foo/bar--- Capture: oo/ba---++{- | Match requests using a regular expression.+Named captures are not yet supported.++>>> :{+let server = S.get (S.regex "^/f(.*)r$") $ do+ cap <- S.pathParam "1"+ S.text cap+ in do+ withScotty server $ curl "http://localhost:3000/foo/bar"+:}+"oo/ba"+-} regex :: String -> RoutePattern regex = Trans.regex @@ -385,21 +501,27 @@ capture :: String -> RoutePattern capture = Trans.capture --- | Build a route based on a function which can match using the entire 'Request' object.--- 'Nothing' indicates the route does not match. A 'Just' value indicates--- a successful match, optionally returning a list of key-value pairs accessible--- by 'param'.------ > get (function $ \req -> Just [("version", pack $ show $ httpVersion req)]) $ do--- > v <- param "version"--- > text v------ >>> curl http://localhost:3000/--- HTTP/1.1---++{- | Build a route based on a function which can match using the entire 'Request' object.+'Nothing' indicates the route does not match. A 'Just' value indicates+a successful match, optionally returning a list of key-value pairs accessible by 'param'.++>>> :{+let server = S.get (function $ \req -> Just [("version", T.pack $ show $ W.httpVersion req)]) $ do+ v <- S.pathParam "version"+ S.text v+ in do+ withScotty server $ curl "http://localhost:3000/"+:}+"HTTP/1.1"+-} function :: (Request -> Maybe [Param]) -> RoutePattern function = Trans.function -- | Build a route that requires the requested path match exactly, without captures. literal :: String -> RoutePattern literal = Trans.literal++++
Web/Scotty/Action.hs view
@@ -16,15 +16,22 @@ , header , headers , html+ , htmlLazy , liftAndCatchIO , json , jsonData , next , param+ , pathParam , captureParam , formParam , queryParam+ , pathParamMaybe+ , captureParamMaybe+ , formParamMaybe+ , queryParamMaybe , params+ , pathParams , captureParams , formParams , queryParams@@ -41,8 +48,13 @@ , status , stream , text+ , textLazy+ , getResponseStatus+ , getResponseHeaders+ , getResponseContent , Param , Parsable(..)+ , ActionT -- private to Scotty , runAction ) where@@ -63,10 +75,11 @@ import qualified Data.ByteString.Lazy.Char8 as BL import qualified Data.CaseInsensitive as CI import Data.Int-import qualified Data.Text as ST-import qualified Data.Text.Encoding as STE-import qualified Data.Text.Lazy as T-import Data.Text.Lazy.Encoding (encodeUtf8)+import Data.Maybe (maybeToList)+import qualified Data.Text as T+import Data.Text.Encoding as STE+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TLE import Data.Word import Network.HTTP.Types@@ -79,8 +92,8 @@ import Numeric.Natural import Web.Scotty.Internal.Types-import Web.Scotty.Util (mkResponse, addIfNotPresent, add, replace, lazyTextToStrictByteString, strictByteStringToLazyText)-import Web.Scotty.Exceptions (Handler(..), catch, catchesOptionally, tryAny)+import Web.Scotty.Util (mkResponse, addIfNotPresent, add, replace, lazyTextToStrictByteString, decodeUtf8Lenient)+import UnliftIO.Exception (Handler(..), catch, catches, throwIO) import Network.Wai.Internal (ResponseReceived(..)) @@ -95,13 +108,11 @@ -> ActionT m () -- ^ Route action to be evaluated -> m (Maybe Response) runAction mh env action = do- let- handlers = [- statusErrorHandler, -- StatusError- actionErrorHandler, -- ActionError i.e. Next, Finish, Redirect- someExceptionHandler -- all remaining exceptions- ]- ok <- flip runReaderT env $ runAM $ tryNext (catchesOptionally action mh handlers )+ ok <- flip runReaderT env $ runAM $ tryNext $ action `catches` concat+ [ [actionErrorHandler]+ , maybeToList mh+ , [statusErrorHandler, scottyExceptionHandler, someExceptionHandler]+ ] res <- getResponse env return $ bool Nothing (Just $ mkResponse res) ok @@ -111,7 +122,7 @@ StatusError s e -> do status s let code = T.pack $ show $ statusCode s- let msg = T.fromStrict $ STE.decodeUtf8 $ statusMessage s+ let msg = decodeUtf8Lenient $ statusMessage s html $ mconcat ["<h1>", code, " ", msg, "</h1>", e] -- | Exception handler in charge of 'ActionError'. Rethrowing 'Next' here is caught by 'tryNext'.@@ -124,26 +135,61 @@ AENext -> next AEFinish -> return () +-- | Default handler for exceptions from scotty+scottyExceptionHandler :: MonadIO m => ErrorHandler m+scottyExceptionHandler = Handler $ \case+ RequestTooLarge -> do+ status status413+ text "Request body is too large"+ MalformedJSON bs err -> do+ status status400+ raw $ BL.unlines+ [ "jsonData: malformed"+ , "Body: " <> bs+ , "Error: " <> BL.fromStrict (encodeUtf8 err)+ ]+ FailedToParseJSON bs err -> do+ status status422+ raw $ BL.unlines+ [ "jsonData: failed to parse"+ , "Body: " <> bs+ , "Error: " <> BL.fromStrict (encodeUtf8 err)+ ]+ PathParameterNotFound k -> do+ status status500+ text $ T.unwords [ "Path parameter", k, "not found"]+ QueryParameterNotFound k -> do+ status status400+ text $ T.unwords [ "Query parameter", k, "not found"]+ FormFieldNotFound k -> do+ status status400+ text $ T.unwords [ "Query parameter", k, "not found"]+ FailedToParseParameter k v e -> do+ status status400+ text $ T.unwords [ "Failed to parse parameter", k, v, ":", e]+ -- | Uncaught exceptions turn into HTTP 500 Server Error codes someExceptionHandler :: MonadIO m => ErrorHandler m someExceptionHandler = Handler $ \case (_ :: E.SomeException) -> status status500 --- | Throw a "500 Server Error" 'StatusError', which can be caught with 'rescue'.+-- | Throw a "500 Server Error" 'StatusError', which can be caught with 'catch'. -- -- Uncaught exceptions turn into HTTP 500 responses. raise :: (MonadIO m) => T.Text -- ^ Error text -> ActionT m a raise = raiseStatus status500+{-# DEPRECATED raise "Throw an exception instead" #-} --- | Throw a 'StatusError' exception that has an associated HTTP error code and can be caught with 'rescue'.+-- | Throw a 'StatusError' exception that has an associated HTTP error code and can be caught with 'catch'. -- -- Uncaught exceptions turn into HTTP responses corresponding to the given status. raiseStatus :: Monad m => Status -> T.Text -> ActionT m a raiseStatus s = E.throw . StatusError s+{-# DEPRECATED raiseStatus "Use status, text, and finish instead" #-} --- | Throw an exception which can be caught within the scope of the current Action with 'rescue' or 'catch'.+-- | Throw an exception which can be caught within the scope of the current Action with 'catch'. -- -- If the exception is not caught locally, another option is to implement a global 'Handler' (with 'defaultHandler') that defines its interpretation and a translation to HTTP error codes. --@@ -161,28 +207,27 @@ -- ever run is if the first one calls 'next'. -- -- > get "/foo/:bar" $ do--- > w :: Text <- captureParam "bar"+-- > w :: Text <- pathParam "bar" -- > unless (w == "special") next -- > text "You made a request to /foo/special" -- > -- > get "/foo/:baz" $ do--- > w <- captureParam "baz"+-- > w <- pathParam "baz" -- > text $ "You made a request to: " <> w next :: Monad m => ActionT m a next = E.throw AENext -- | Catch an exception e.g. a 'StatusError' or a user-defined exception. ----- > raise JustKidding `rescue` (\msg -> text msg)+-- > raise JustKidding `catch` (\msg -> text msg) rescue :: (MonadUnliftIO m, E.Exception e) => ActionT m a -> (e -> ActionT m a) -> ActionT m a rescue = catch+{-# DEPRECATED rescue "Use catch instead" #-} -- | Catch any synchronous IO exceptions liftAndCatchIO :: MonadIO m => IO a -> ActionT m a-liftAndCatchIO io = liftIO $ do- r <- tryAny io- either E.throwIO pure r-+liftAndCatchIO = liftIO+{-# DEPRECATED liftAndCatchIO "Use liftIO instead" #-} -- | Redirect to given URL. Like throwing an uncatchable exception. Any code after the call to redirect -- will not be run.@@ -214,14 +259,14 @@ header :: (Monad m) => T.Text -> ActionT m (Maybe T.Text) header k = do hs <- requestHeaders <$> request- return $ fmap strictByteStringToLazyText $ lookup (CI.mk (lazyTextToStrictByteString k)) hs+ return $ fmap decodeUtf8Lenient $ lookup (CI.mk (encodeUtf8 k)) hs -- | Get all the request headers. Header names are case-insensitive. headers :: (Monad m) => ActionT m [(T.Text, T.Text)] headers = do hs <- requestHeaders <$> request- return [ ( strictByteStringToLazyText (CI.original k)- , strictByteStringToLazyText v)+ return [ ( decodeUtf8Lenient (CI.original k)+ , decodeUtf8Lenient v) | (k,v) <- hs ] -- | Get the request body.@@ -246,27 +291,16 @@ jsonData :: (A.FromJSON a, MonadIO m) => ActionT m a jsonData = do b <- body- when (b == "") $ do- let htmlError = "jsonData - No data was provided."- raiseStatus status400 $ T.pack htmlError+ when (b == "") $ throwIO $ MalformedJSON b "no data" case A.eitherDecode b of- Left err -> do- let htmlError = "jsonData - malformed."- `mappend` " Data was: " `mappend` BL.unpack b- `mappend` " Error was: " `mappend` err- raiseStatus status400 $ T.pack htmlError+ Left err -> throwIO $ MalformedJSON b $ T.pack err Right value -> case A.fromJSON value of- A.Error err -> do- let htmlError = "jsonData - failed parse."- `mappend` " Data was: " `mappend` BL.unpack b `mappend` "."- `mappend` " Error was: " `mappend` err- raiseStatus status422 $ T.pack htmlError- A.Success a -> do- return a+ A.Error err -> throwIO $ FailedToParseJSON b $ T.pack err+ A.Success a -> return a -- | Get a parameter. First looks in captures, then form data, then query parameters. ----- * Raises an exception which can be caught by 'rescue' if parameter is not found.+-- * Raises an exception which can be caught by 'catch' if parameter is not found. -- -- * If parameter is found, but 'parseParam' fails to parse to the correct type, 'next' is called. -- This means captures are somewhat typed, in that a route won't match if a correctly typed@@ -276,66 +310,133 @@ val <- ActionT $ (lookup k . getParams) <$> ask case val of Nothing -> raiseStatus status500 $ "Param: " <> k <> " not found!" -- FIXME- Just v -> either (const next) return $ parseParam v+ Just v -> either (const next) return $ parseParam (TL.fromStrict v) {-# DEPRECATED param "(#204) Not a good idea to treat all parameters identically. Use captureParam, formParam and queryParam instead. "#-} --- | Get a capture parameter.+-- | Synonym for 'pathParam'+captureParam :: (Parsable a, MonadIO m) => T.Text -> ActionT m a+captureParam = pathParam++-- | Look up a path parameter. ----- * Raises an exception which can be caught by 'rescue' if parameter is not found. If the exception is not caught, scotty will return a HTTP error code 500 ("Internal Server Error") to the client.+-- * Raises an exception which can be caught by 'catch' if parameter is not found. If the exception is not caught, scotty will return a HTTP error code 500 ("Internal Server Error") to the client. -- -- * If the parameter is found, but 'parseParam' fails to parse to the correct type, 'next' is called.-captureParam :: (Parsable a, Monad m) => T.Text -> ActionT m a-captureParam = paramWith CaptureParam envCaptureParams status500+--+-- /Since: 0.20/+pathParam :: (Parsable a, MonadIO m) => T.Text -> ActionT m a+pathParam k = do+ val <- ActionT $ lookup k . envPathParams <$> ask+ case val of+ Nothing -> throwIO $ PathParameterNotFound k+ Just v -> case parseParam $ TL.fromStrict v of+ Left _ -> next+ Right a -> pure a --- | Get a form parameter.+-- | Look up a form parameter. ----- * Raises an exception which can be caught by 'rescue' if parameter is not found. If the exception is not caught, scotty will return a HTTP error code 400 ("Bad Request") to the client.+-- * Raises an exception which can be caught by 'catch' if parameter is not found. If the exception is not caught, scotty will return a HTTP error code 400 ("Bad Request") to the client. -- -- * This function raises a code 400 also if the parameter is found, but 'parseParam' fails to parse to the correct type.-formParam :: (Parsable a, Monad m) => T.Text -> ActionT m a-formParam = paramWith FormParam envFormParams status400+--+-- /Since: 0.20/+formParam :: (Parsable a, MonadIO m) => T.Text -> ActionT m a+formParam = paramWith FormFieldNotFound envFormParams --- | Get a query parameter.+-- | Look up a query parameter. ----- * Raises an exception which can be caught by 'rescue' if parameter is not found. If the exception is not caught, scotty will return a HTTP error code 400 ("Bad Request") to the client.+-- * Raises an exception which can be caught by 'catch' if parameter is not found. If the exception is not caught, scotty will return a HTTP error code 400 ("Bad Request") to the client. -- -- * This function raises a code 400 also if the parameter is found, but 'parseParam' fails to parse to the correct type.-queryParam :: (Parsable a, Monad m) => T.Text -> ActionT m a-queryParam = paramWith QueryParam envQueryParams status400+--+-- /Since: 0.20/+queryParam :: (Parsable a, MonadIO m) => T.Text -> ActionT m a+queryParam = paramWith QueryParameterNotFound envQueryParams -data ParamType = CaptureParam+-- | Look up a path parameter. Returns 'Nothing' if the parameter is not found or cannot be parsed at the right type.+--+-- NB : Doesn't throw exceptions. In particular, route pattern matching will not continue, so developers+-- must 'raiseStatus' or 'throw' to signal something went wrong.+--+-- /Since: 0.21/+pathParamMaybe :: (Parsable a, Monad m) => T.Text -> ActionT m (Maybe a)+pathParamMaybe = paramWithMaybe envPathParams++-- | Look up a capture parameter. Returns 'Nothing' if the parameter is not found or cannot be parsed at the right type.+--+-- NB : Doesn't throw exceptions. In particular, route pattern matching will not continue, so developers+-- must 'raiseStatus' or 'throw' to signal something went wrong.+--+-- /Since: 0.21/+captureParamMaybe :: (Parsable a, Monad m) => T.Text -> ActionT m (Maybe a)+captureParamMaybe = paramWithMaybe envPathParams++-- | Look up a form parameter. Returns 'Nothing' if the parameter is not found or cannot be parsed at the right type.+--+-- NB : Doesn't throw exceptions, so developers must 'raiseStatus' or 'throw' to signal something went wrong.+--+-- /Since: 0.21/+formParamMaybe :: (Parsable a, Monad m) => T.Text -> ActionT m (Maybe a)+formParamMaybe = paramWithMaybe envFormParams++-- | Look up a query parameter. Returns 'Nothing' if the parameter is not found or cannot be parsed at the right type.+--+-- NB : Doesn't throw exceptions, so developers must 'raiseStatus' or 'throw' to signal something went wrong.+--+-- /Since: 0.21/+queryParamMaybe :: (Parsable a, Monad m) => T.Text -> ActionT m (Maybe a)+queryParamMaybe = paramWithMaybe envQueryParams++data ParamType = PathParam | FormParam | QueryParam instance Show ParamType where show = \case- CaptureParam -> "capture"+ PathParam -> "path" FormParam -> "form" QueryParam -> "query" -paramWith :: (Monad m, Parsable b) =>- ParamType+paramWith :: (MonadIO m, Parsable b) =>+ (T.Text -> ScottyException) -> (ActionEnv -> [Param])- -> Status -- ^ HTTP status to return if parameter is not found -> T.Text -- ^ parameter name -> ActionT m b-paramWith ty f err k = do+paramWith toError f k = do val <- ActionT $ (lookup k . f) <$> ask case val of- Nothing -> raiseStatus err (T.unwords [T.pack (show ty), "parameter:", k, "not found!"])- Just v ->- let handleParseError = \case- CaptureParam -> next- _ -> raiseStatus err (T.unwords ["Cannot parse", v, "as a", T.pack (show ty), "parameter"])- in either (const $ handleParseError ty) return $ parseParam v+ Nothing -> throwIO $ toError k+ Just v -> case parseParam $ TL.fromStrict v of+ Left e -> throwIO $ FailedToParseParameter k v (TL.toStrict e)+ Right a -> pure a --- | Get all parameters from capture, form and query (in that order).+-- | Look up a parameter. Returns 'Nothing' if the parameter is not found or cannot be parsed at the right type.+--+-- NB : Doesn't throw exceptions.+--+-- /Since: FIXME/+paramWithMaybe :: (Monad m, Parsable b) =>+ (ActionEnv -> [Param])+ -> T.Text -- ^ parameter name+ -> ActionT m (Maybe b)+paramWithMaybe f k = do+ val <- ActionT $ (lookup k . f) <$> ask+ case val of+ Nothing -> pure Nothing+ Just v -> either (const $ pure Nothing) (pure . Just) $ parseParam $ TL.fromStrict v++-- | Get all parameters from path, form and query (in that order). params :: Monad m => ActionT m [Param] params = paramsWith getParams-{-# DEPRECATED params "(#204) Not a good idea to treat all parameters identically. Use captureParams, formParams and queryParams instead. "#-}+{-# DEPRECATED params "(#204) Not a good idea to treat all parameters identically. Use pathParams, formParams and queryParams instead. "#-} --- | Get capture parameters+-- | Get path parameters+pathParams :: Monad m => ActionT m [Param]+pathParams = paramsWith envPathParams++-- | Get path parameters captureParams :: Monad m => ActionT m [Param]-captureParams = paramsWith envCaptureParams+captureParams = paramsWith envPathParams+ -- | Get form parameters formParams :: Monad m => ActionT m [Param] formParams = paramsWith envFormParams@@ -348,44 +449,64 @@ {-# DEPRECATED getParams "(#204) Not a good idea to treat all parameters identically" #-} getParams :: ActionEnv -> [Param]-getParams e = envCaptureParams e <> envFormParams e <> envQueryParams e+getParams e = envPathParams e <> envFormParams e <> envQueryParams e ++-- === access the fields of the Response being constructed++-- | Access the HTTP 'Status' of the Response+--+-- /SINCE 0.21/+getResponseStatus :: (MonadIO m) => ActionT m Status+getResponseStatus = srStatus <$> getResponseAction+-- | Access the HTTP headers of the Response+--+-- /SINCE 0.21/+getResponseHeaders :: (MonadIO m) => ActionT m ResponseHeaders+getResponseHeaders = srHeaders <$> getResponseAction+-- | Access the content of the Response+--+-- /SINCE 0.21/+getResponseContent :: (MonadIO m) => ActionT m Content+getResponseContent = srContent <$> getResponseAction++ -- | Minimum implemention: 'parseParam' class Parsable a where -- | Take a 'T.Text' value and parse it as 'a', or fail with a message.- parseParam :: T.Text -> Either T.Text a+ parseParam :: TL.Text -> Either TL.Text a -- | Default implementation parses comma-delimited lists. -- -- > parseParamList t = mapM parseParam (T.split (== ',') t)- parseParamList :: T.Text -> Either T.Text [a]- parseParamList t = mapM parseParam (T.split (== ',') t)+ parseParamList :: TL.Text -> Either TL.Text [a]+ parseParamList t = mapM parseParam (TL.split (== ',') t) -- No point using 'read' for Text, ByteString, Char, and String.-instance Parsable T.Text where parseParam = Right-instance Parsable ST.Text where parseParam = Right . T.toStrict+instance Parsable T.Text where parseParam = Right . TL.toStrict+instance Parsable TL.Text where parseParam = Right instance Parsable B.ByteString where parseParam = Right . lazyTextToStrictByteString-instance Parsable BL.ByteString where parseParam = Right . encodeUtf8+instance Parsable BL.ByteString where parseParam = Right . TLE.encodeUtf8 -- | Overrides default 'parseParamList' to parse String. instance Parsable Char where- parseParam t = case T.unpack t of+ parseParam t = case TL.unpack t of [c] -> Right c _ -> Left "parseParam Char: no parse"- parseParamList = Right . T.unpack -- String+ parseParamList = Right . TL.unpack -- String -- | Checks if parameter is present and is null-valued, not a literal '()'. -- If the URI requested is: '/foo?bar=()&baz' then 'baz' will parse as (), where 'bar' will not. instance Parsable () where- parseParam t = if T.null t then Right () else Left "parseParam Unit: no parse"+ parseParam t = if TL.null t then Right () else Left "parseParam Unit: no parse" instance (Parsable a) => Parsable [a] where parseParam = parseParamList instance Parsable Bool where- parseParam t = if t' == T.toCaseFold "true"+ parseParam t = if t' == TL.toCaseFold "true" then Right True- else if t' == T.toCaseFold "false"+ else if t' == TL.toCaseFold "false" then Right False else Left "parseParam Bool: no parse"- where t' = T.toCaseFold t+ where t' = TL.toCaseFold t instance Parsable Double where parseParam = readEither instance Parsable Float where parseParam = readEither@@ -407,8 +528,8 @@ -- | Useful for creating 'Parsable' instances for things that already implement 'Read'. Ex: -- -- > instance Parsable Int where parseParam = readEither-readEither :: Read a => T.Text -> Either T.Text a-readEither t = case [ x | (x,"") <- reads (T.unpack t) ] of+readEither :: Read a => TL.Text -> Either TL.Text a+readEither t = case [ x | (x,"") <- reads (TL.unpack t) ] of [x] -> Right x [] -> Left "readEither: no parse" _ -> Left "readEither: ambiguous parse"@@ -422,7 +543,7 @@ => (CI.CI B.ByteString -> B.ByteString -> [(HeaderName, B.ByteString)] -> [(HeaderName, B.ByteString)]) -> T.Text -> T.Text -> ActionT m () changeHeader f k =- modifyResponse . setHeaderWith . f (CI.mk $ lazyTextToStrictByteString k) . lazyTextToStrictByteString+ modifyResponse . setHeaderWith . f (CI.mk $ encodeUtf8 k) . encodeUtf8 -- | Add to the response headers. Header names are case-insensitive. addHeader :: MonadIO m => T.Text -> T.Text -> ActionT m ()@@ -438,15 +559,29 @@ text :: (MonadIO m) => T.Text -> ActionT m () text t = do changeHeader addIfNotPresent "Content-Type" "text/plain; charset=utf-8"- raw $ encodeUtf8 t+ raw $ BL.fromStrict $ encodeUtf8 t -- | Set the body of the response to the given 'T.Text' value. Also sets \"Content-Type\"+-- header to \"text/plain; charset=utf-8\" if it has not already been set.+textLazy :: (MonadIO m) => TL.Text -> ActionT m ()+textLazy t = do+ changeHeader addIfNotPresent "Content-Type" "text/plain; charset=utf-8"+ raw $ TLE.encodeUtf8 t++-- | Set the body of the response to the given 'T.Text' value. Also sets \"Content-Type\" -- header to \"text/html; charset=utf-8\" if it has not already been set. html :: (MonadIO m) => T.Text -> ActionT m () html t = do changeHeader addIfNotPresent "Content-Type" "text/html; charset=utf-8"- raw $ encodeUtf8 t+ raw $ BL.fromStrict $ encodeUtf8 t +-- | Set the body of the response to the given 'T.Text' value. Also sets \"Content-Type\"+-- header to \"text/html; charset=utf-8\" if it has not already been set.+htmlLazy :: (MonadIO m) => TL.Text -> ActionT m ()+htmlLazy t = do+ changeHeader addIfNotPresent "Content-Type" "text/html; charset=utf-8"+ raw $ TLE.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'. Setting a status code will have no effect -- because Warp will overwrite that to 200 (see 'Network.Wai.Handler.Warp.Internal.sendResponse').@@ -482,6 +617,6 @@ -- Is MVar really the best choice here? Not sure. r <- request ref <- liftIO $ newEmptyMVar- _ <- liftAndCatchIO $ app r (\res -> putMVar ref res >> return ResponseReceived)- res <- liftAndCatchIO $ readMVar ref+ _ <- liftIO $ app r (\res -> putMVar ref res >> return ResponseReceived)+ res <- liftIO $ readMVar ref rawResponse res
Web/Scotty/Body.hs view
@@ -20,7 +20,7 @@ import qualified Network.Wai.Parse as W (File, Param, getRequestBodyType, BackEnd, lbsBackEnd, sinkRequestBody) import Web.Scotty.Action (Param) import Web.Scotty.Internal.Types (BodyInfo(..), BodyChunkBuffer(..), BodyPartiallyStreamed(..), RouteOptions(..))-import Web.Scotty.Util (readRequestBody, strictByteStringToLazyText)+import Web.Scotty.Util (readRequestBody, strictByteStringToLazyText, decodeUtf8Lenient) -- | Make a new BodyInfo with readProgress at 0 and an empty BodyChunkBuffer. newBodyInfo :: (MonadIO m) => Request -> m BodyInfo@@ -47,7 +47,7 @@ bs <- getBodyAction bodyInfo opts let wholeBody = BL.toChunks bs (formparams, fs) <- parseRequestBody wholeBody W.lbsBackEnd req -- NB this loads the whole body into memory- let convert (k, v) = (strictByteStringToLazyText k, strictByteStringToLazyText v)+ let convert (k, v) = (decodeUtf8Lenient k, decodeUtf8Lenient v) return (convert <$> formparams, fs) else return ([], [])
Web/Scotty/Cookie.hs view
@@ -79,21 +79,23 @@ -- cookie import Web.Cookie (SetCookie, setCookieName , setCookieValue, setCookiePath, setCookieExpires, setCookieMaxAge, setCookieDomain, setCookieHttpOnly, setCookieSecure, setCookieSameSite, renderSetCookie, defaultSetCookie, CookiesText, parseCookiesText, SameSiteOption, sameSiteStrict, sameSiteNone, sameSiteLax) -- scotty-import Web.Scotty.Trans (ActionT, addHeader, header)+import Web.Scotty.Action (ActionT, addHeader, header) -- time import Data.Time.Clock.POSIX ( posixSecondsToUTCTime ) -- text import Data.Text (Text) import qualified Data.Text.Encoding as T (encodeUtf8)-import qualified Data.Text.Lazy.Encoding as TL (encodeUtf8, decodeUtf8)--+import Web.Scotty.Util (decodeUtf8Lenient) -- | Set a cookie, with full access to its options (see 'SetCookie') setCookie :: (MonadIO m) => SetCookie -> ActionT m ()-setCookie c = addHeader "Set-Cookie" (TL.decodeUtf8 . toLazyByteString $ renderSetCookie c)+setCookie c = addHeader "Set-Cookie"+ $ decodeUtf8Lenient+ $ BSL.toStrict+ $ toLazyByteString+ $ renderSetCookie c -- | 'makeSimpleCookie' and 'setCookie' combined.@@ -114,7 +116,7 @@ getCookies :: (Monad m) => ActionT m CookiesText getCookies = (maybe [] parse) <$> header "Cookie"- where parse = parseCookiesText . BSL.toStrict . TL.encodeUtf8+ where parse = parseCookiesText . T.encodeUtf8 -- | Browsers don't directly delete a cookie, but setting its expiry to a past date (e.g. the UNIX epoch) ensures that the cookie will be invalidated (whether and when it will be actually deleted by the browser seems to be browser-dependent). deleteCookie :: (MonadIO m)
− Web/Scotty/Exceptions.hs
@@ -1,25 +0,0 @@-{-# LANGUAGE ExistentialQuantification #-}-module Web.Scotty.Exceptions (- Handler(..)- -- * catching- , catch- , catchAny- , catches- , catchesOptionally- -- * trying- , try- , tryAny- ) where--import Data.Maybe (maybeToList)--import UnliftIO (MonadUnliftIO(..), catch, catchAny, catches, try, tryAny, Handler(..))----- | Handlers are tried sequentially-catchesOptionally :: MonadUnliftIO m =>- m a- -> Maybe (Handler m a) -- ^ if present, this 'Handler' is tried first- -> [Handler m a] -- ^ these are tried in order- -> m a-catchesOptionally io mh handlers = io `catches` (maybeToList mh <> handlers)
Web/Scotty/Internal/Types.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleInstances #-}@@ -22,7 +21,7 @@ import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.IO.Class (MonadIO(..)) import UnliftIO (MonadUnliftIO(..))-import Control.Monad.Reader (MonadReader(..), ReaderT, asks)+import Control.Monad.Reader (MonadReader(..), ReaderT, asks, mapReaderT) import Control.Monad.State.Strict (State, StateT(..)) import Control.Monad.Trans.Class (MonadTrans(..)) import Control.Monad.Trans.Control (MonadBaseControl, MonadTransControl)@@ -31,7 +30,7 @@ import qualified Data.ByteString.Lazy.Char8 as LBS8 (ByteString) import Data.Default.Class (Default, def) import Data.String (IsString(..))-import Data.Text.Lazy (Text, pack)+import Data.Text (Text, pack) import Data.Typeable (Typeable) import Network.HTTP.Types@@ -41,7 +40,7 @@ import Network.Wai.Handler.Warp (Settings, defaultSettings) import Network.Wai.Parse (FileInfo) -import Web.Scotty.Exceptions (Handler(..), catch, catches)+import UnliftIO.Exception (Handler(..), catch, catches) --------------------- Options -----------------------@@ -143,12 +142,21 @@ -- | E.g. when a parameter is not found in a query string (400 Bad Request) or when parsing a JSON body fails (422 Unprocessable Entity) data StatusError = StatusError Status Text deriving (Show, Typeable) instance E.Exception StatusError+{-# DEPRECATED StatusError "If it is supposed to be caught, a proper exception type should be defined" #-} -- | Specializes a 'Handler' to the 'ActionT' monad type ErrorHandler m = Handler (ActionT m) () -- | Thrown e.g. when a request is too large-data ScottyException = RequestException BS.ByteString Status deriving (Show, Typeable)+data ScottyException+ = RequestTooLarge+ | MalformedJSON LBS8.ByteString Text+ | FailedToParseJSON LBS8.ByteString Text+ | PathParameterNotFound Text+ | QueryParameterNotFound Text+ | FormFieldNotFound Text+ | FailedToParseParameter Text Text Text+ deriving (Show, Typeable) instance E.Exception ScottyException ------------------ Scotty Actions -------------------@@ -157,7 +165,7 @@ type File = (Text, FileInfo LBS8.ByteString) data ActionEnv = Env { envReq :: Request- , envCaptureParams :: [Param]+ , envPathParams :: [Param] , envFormParams :: [Param] , envQueryParams :: [Param] , envBody :: IO LBS8.ByteString@@ -169,9 +177,14 @@ getResponse :: MonadIO m => ActionEnv -> m ScottyResponse getResponse ae = liftIO $ readTVarIO (envResponse ae) +getResponseAction :: (MonadIO m) => ActionT m ScottyResponse+getResponseAction = do+ ae <- ActionT ask+ getResponse ae+ modifyResponse :: (MonadIO m) => (ScottyResponse -> ScottyResponse) -> ActionT m () modifyResponse f = do- tv <- asks envResponse+ tv <- ActionT $ asks envResponse liftIO $ atomically $ modifyTVar' tv f data BodyPartiallyStreamed = BodyPartiallyStreamed deriving (Show, Typeable)@@ -206,13 +219,17 @@ newtype ActionT m a = ActionT { runAM :: ReaderT ActionEnv m a }- deriving newtype (Functor, Applicative, Monad, MonadIO, MonadReader ActionEnv, MonadTrans, MonadThrow, MonadCatch, MonadBase b, MonadBaseControl b, MonadTransControl, MonadUnliftIO)+ deriving newtype (Functor, Applicative, Monad, MonadIO, MonadTrans, MonadThrow, MonadCatch, MonadBase b, MonadBaseControl b, MonadTransControl, MonadUnliftIO) +instance MonadReader r m => MonadReader r (ActionT m) where+ ask = ActionT $ lift ask+ local f = ActionT . mapReaderT (local f) . runAM+ -- | Models the invariant that only 'StatusError's can be thrown and caught. instance (MonadUnliftIO m) => MonadError StatusError (ActionT m) where throwError = E.throw catchError = catch--- | Modeled after the behaviour in scotty < 0.20, 'fail' throws a 'StatusError' with code 500 ("Server Error"), which can be caught with 'E.catch' or 'rescue'.+-- | Modeled after the behaviour in scotty < 0.20, 'fail' throws a 'StatusError' with code 500 ("Server Error"), which can be caught with 'E.catch'. instance (MonadIO m) => MonadFail (ActionT m) where fail = E.throw . StatusError status500 . pack -- | 'empty' throws 'ActionError' 'AENext', whereas '(<|>)' catches any 'ActionError's or 'StatusError's in the first action and proceeds to the second one.@@ -225,52 +242,34 @@ mzero = empty mplus = (<|>) --- | catches either ActionError (thrown by 'next') or 'StatusError' (thrown if e.g. a query parameter is not found)+-- | catches either ActionError (thrown by 'next'),+-- 'ScottyException' (thrown if e.g. a query parameter is not found)+-- or 'StatusError' (via 'raiseStatus') tryAnyStatus :: MonadUnliftIO m => m a -> m Bool-tryAnyStatus io = (io >> pure True) `catches` [h1, h2]+tryAnyStatus io = (io >> pure True) `catches` [h1, h2, h3] where h1 = Handler $ \(_ :: ActionError) -> pure False h2 = Handler $ \(_ :: StatusError) -> pure False+ h3 = Handler $ \(_ :: ScottyException) -> pure False instance (Semigroup a) => Semigroup (ScottyT m a) where x <> y = (<>) <$> x <*> y instance ( Monoid a-#if !(MIN_VERSION_base(4,11,0))- , Semigroup a-#endif-#if !(MIN_VERSION_base(4,8,0))- , Functor m-#endif ) => Monoid (ScottyT m a) where mempty = return mempty-#if !(MIN_VERSION_base(4,11,0))- mappend = (<>)-#endif instance ( Monad m-#if !(MIN_VERSION_base(4,8,0))- , Functor m-#endif , Semigroup a ) => Semigroup (ActionT m a) where x <> y = (<>) <$> x <*> y instance ( Monad m, Monoid a-#if !(MIN_VERSION_base(4,11,0))- , Semigroup a-#endif-#if !(MIN_VERSION_base(4,8,0))- , Functor m-#endif ) => Monoid (ActionT m a) where mempty = return mempty-#if !(MIN_VERSION_base(4,11,0))- mappend = (<>)-#endif ------------------ Scotty Routes -------------------- data RoutePattern = Capture Text
Web/Scotty/Route.hs view
@@ -11,12 +11,8 @@ import UnliftIO (MonadUnliftIO(..)) import qualified Control.Monad.State as MS -import qualified Data.ByteString.Char8 as B--import Data.Maybe (fromMaybe) import Data.String (fromString)-import qualified Data.Text.Lazy as T-import qualified Data.Text as TS+import qualified Data.Text as T import Network.HTTP.Types import Network.Wai (Request(..))@@ -25,9 +21,37 @@ import Web.Scotty.Action import Web.Scotty.Internal.Types (RoutePattern(..), RouteOptions, ActionEnv(..), ActionT, ScottyState(..), ScottyT(..), ErrorHandler, Middleware, BodyInfo, handler, addRoute, defaultScottyResponse)-import Web.Scotty.Util (strictByteStringToLazyText)+import Web.Scotty.Util (decodeUtf8Lenient) import Web.Scotty.Body (cloneBodyInfo, getBodyAction, getBodyChunkAction, getFormParamsAndFilesAction) +{- $setup+>>> :{+import Control.Monad.IO.Class (MonadIO(..))+import qualified Network.HTTP.Client as H+import qualified Network.HTTP.Types as H+import qualified Network.Wai as W (httpVersion)+import qualified Data.ByteString.Lazy.Char8 as LBS (unpack)+import qualified Data.Text as T (pack)+import Control.Concurrent (ThreadId, forkIO, killThread)+import Control.Exception (bracket)+import qualified Web.Scotty as S (ScottyM, scottyOpts, get, text, regex, pathParam, Options(..), defaultOptions)+-- | GET an HTTP path+curl :: MonadIO m =>+ String -- ^ path+ -> m String -- ^ response body+curl path = liftIO $ do+ req0 <- H.parseRequest path+ let req = req0 { H.method = "GET"}+ mgr <- H.newManager H.defaultManagerSettings+ (LBS.unpack . H.responseBody) <$> H.httpLbs req mgr+-- | Fork a process, run a Scotty server in it and run an action while the server is running. Kills the scotty thread once the inner action is done.+withScotty :: S.ScottyM ()+ -> IO a -- ^ inner action, e.g. 'curl "localhost:3000/"'+ -> IO a+withScotty serv act = bracket (forkIO $ S.scottyOpts (S.defaultOptions{ S.verbose = 0 }) serv) killThread (\_ -> act)+:}+-}+ -- | get = 'addroute' 'GET' get :: (MonadUnliftIO m) => RoutePattern -> ActionT m () -> ScottyT m () get = addroute GET@@ -61,23 +85,21 @@ notFound :: (MonadUnliftIO m) => ActionT m () -> ScottyT m () notFound action = matchAny (Function (\req -> Just [("path", path req)])) (status status404 >> action) --- | Define a route with a 'StdMethod', 'T.Text' value representing the path spec,--- and a body ('Action') which modifies the response.------ > addroute GET "/" $ text "beam me up!"------ The path spec can include values starting with a colon, which are interpreted--- as /captures/. These are named wildcards that can be looked up with 'captureParam'.------ > addroute GET "/foo/:bar" $ do--- > v <- captureParam "bar"--- > text v------ >>> curl http://localhost:3000/foo/something--- something------ NB: the 'RouteOptions' and the exception handler of the newly-created route will be--- copied from the previously-created routes.+{- | Define a route with a 'StdMethod', a route pattern representing the path spec,+and an 'Action' which may modify the response.++> get "/" $ text "beam me up!"++The path spec can include values starting with a colon, which are interpreted+as /captures/. These are parameters that can be looked up with 'pathParam'.++>>> :{+let server = S.get "/foo/:bar" (S.pathParam "bar" >>= S.text)+ in do+ withScotty server $ curl "http://localhost:3000/foo/something"+:}+"something"+-} addroute :: (MonadUnliftIO m) => StdMethod -> RoutePattern -> ActionT m () -> ScottyT m () addroute method pat action = ScottyT $ MS.modify $ \s -> addRoute (route (routeOptions s) (handler s) (Just method) pat action) s @@ -86,10 +108,8 @@ -> Maybe (ErrorHandler m) -> Maybe StdMethod -> RoutePattern -> ActionT m () -> BodyInfo -> Middleware m route opts h method pat action bodyInfo app req = let tryNext = app req- {- |- We match all methods in the case where 'method' is 'Nothing'.- See https://github.com/scotty-web/scotty/issues/196 and 'matchAny'- -}+ -- We match all methods in the case where 'method' is 'Nothing'.+ -- See https://github.com/scotty-web/scotty/issues/196 and 'matchAny' methodMatches :: Bool methodMatches = maybe True (\x -> (Right x == parseMethod (requestMethod req))) method @@ -114,7 +134,7 @@ matchRoute (Literal pat) req | pat == path req = Just [] | otherwise = Nothing matchRoute (Function fun) req = fun req-matchRoute (Capture pat) req = go (T.split (=='/') pat) (compress $ T.split (=='/') $ path req) []+matchRoute (Capture pat) req = go (T.split (=='/') pat) (compress $ "":pathInfo req) [] -- add empty segment to simulate being at the root where go [] [] prs = Just prs -- request string and pattern match! go [] r prs | T.null (mconcat r) = Just prs -- in case request has trailing slashes | otherwise = Nothing -- request string is longer than pattern@@ -130,38 +150,38 @@ -- Pretend we are at the top level. path :: Request -> T.Text-path = T.fromStrict . TS.cons '/' . TS.intercalate "/" . pathInfo+path = T.cons '/' . T.intercalate "/" . pathInfo -- | Parse the request and construct the initial 'ActionEnv' with a default 200 OK response mkEnv :: MonadIO m => BodyInfo -> Request -> [Param] -> RouteOptions -> m ActionEnv mkEnv bodyInfo req captureps opts = do (formps, bodyFiles) <- liftIO $ getFormParamsAndFilesAction req bodyInfo opts let- queryps = parseEncodedParams $ rawQueryString req- bodyFiles' = [ (strictByteStringToLazyText k, fi) | (k,fi) <- bodyFiles ]+ queryps = parseEncodedParams $ queryString req+ bodyFiles' = [ (decodeUtf8Lenient k, fi) | (k,fi) <- bodyFiles ] responseInit <- liftIO $ newTVarIO defaultScottyResponse return $ Env req captureps formps queryps (getBodyAction bodyInfo opts) (getBodyChunkAction bodyInfo) bodyFiles' responseInit -parseEncodedParams :: B.ByteString -> [Param]-parseEncodedParams bs = [ (T.fromStrict k, T.fromStrict $ fromMaybe "" v) | (k,v) <- parseQueryText bs ]+parseEncodedParams :: Query -> [Param]+parseEncodedParams qs = [ ( decodeUtf8Lenient k, maybe "" decodeUtf8Lenient v) | (k,v) <- qs ] --- | Match requests using a regular expression.--- Named captures are not yet supported.------ > get (regex "^/f(.*)r$") $ do--- > path <- param "0"--- > cap <- param "1"--- > text $ mconcat ["Path: ", path, "\nCapture: ", cap]------ >>> curl http://localhost:3000/foo/bar--- Path: /foo/bar--- Capture: oo/ba---+{- | Match requests using a regular expression.+Named captures are not yet supported.++>>> :{+let server = S.get (S.regex "^/f(.*)r$") $ do+ cap <- S.pathParam "1"+ S.text cap+ in do+ withScotty server $ curl "http://localhost:3000/foo/bar"+:}+"oo/ba"+-} regex :: String -> RoutePattern-regex pattern = Function $ \ req -> fmap (map (T.pack . show *** T.pack) . zip [0 :: Int ..] . strip)+regex pat = Function $ \ req -> fmap (map (T.pack . show *** T.pack) . zip [0 :: Int ..] . strip) (Regex.matchRegexAll rgx $ T.unpack $ path req)- where rgx = Regex.mkRegex pattern+ where rgx = Regex.mkRegex pat strip (_, match, _, subs) = match : subs -- | Standard Sinatra-style route. Named captures are prepended with colons.@@ -179,18 +199,19 @@ capture :: String -> RoutePattern capture = fromString --- | Build a route based on a function which can match using the entire 'Request' object.--- 'Nothing' indicates the route does not match. A 'Just' value indicates--- a successful match, optionally returning a list of key-value pairs accessible--- by 'param'.------ > get (function $ \req -> Just [("version", T.pack $ show $ httpVersion req)]) $ do--- > v <- param "version"--- > text v------ >>> curl http://localhost:3000/--- HTTP/1.1---+{- | Build a route based on a function which can match using the entire 'Request' object.+'Nothing' indicates the route does not match. A 'Just' value indicates+a successful match, optionally returning a list of key-value pairs accessible by 'param'.++>>> :{+let server = S.get (function $ \req -> Just [("version", T.pack $ show $ W.httpVersion req)]) $ do+ v <- S.pathParam "version"+ S.text v+ in do+ withScotty server $ curl "http://localhost:3000/"+:}+"HTTP/1.1"+-} function :: (Request -> Maybe [Param]) -> RoutePattern function = Function
Web/Scotty/Trans.hs view
@@ -4,15 +4,22 @@ -- OverloadedStrings language pragma. -- -- The functions in this module allow an arbitrary monad to be embedded--- in Scotty's monad transformer stack in order that Scotty be combined--- with other DSLs.+-- in Scotty's monad transformer stack, e.g. for complex endpoint configuration,+-- interacting with databases etc. -- -- Scotty is set up by default for development mode. For production servers, -- you will likely want to modify 'settings' and the 'defaultHandler'. See -- the comments on each of these functions for more information.+--+-- Please refer to the @examples@ directory and the @spec@ test suite for concrete use cases, e.g. constructing responses, exception handling and useful implementation details. module Web.Scotty.Trans- ( -- * scotty-to-WAI- scottyT, scottyAppT, scottyOptsT, scottySocketT, Options(..), defaultOptions+ ( -- * Running 'scotty' servers+ scottyT+ , scottyOptsT+ , scottySocketT+ , Options(..), defaultOptions+ -- ** scotty-to-WAI+ , scottyAppT -- * Defining Middleware and Routes -- -- | 'Middleware' and routes are run in the order in which they@@ -21,50 +28,60 @@ , middleware, get, post, put, delete, patch, options, addroute, matchAny, notFound, setMaxRequestBodySize -- ** Route Patterns , capture, regex, function, literal- -- ** Accessing the Request, Captures, and Query Parameters- , request, header, headers, body, bodyReader- , param, params- , captureParam, formParam, queryParam- , captureParams, formParams, queryParams+ -- ** Accessing the Request and its fields+ , request, Lazy.header, Lazy.headers, body, bodyReader , jsonData, files+ -- ** Accessing Path, Form and Query Parameters+ , param, params+ , pathParam, captureParam, formParam, queryParam+ , pathParamMaybe, captureParamMaybe, formParamMaybe, queryParamMaybe+ , pathParams, captureParams, formParams, queryParams -- ** Modifying the Response and Redirecting- , status, addHeader, setHeader, redirect+ , status, Lazy.addHeader, Lazy.setHeader, Lazy.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, stream, raw, nested+ , Lazy.text, Lazy.html, file, json, stream, raw, nested+ -- ** Accessing the fields of the Response+ , getResponseHeaders, getResponseStatus, getResponseContent -- ** Exceptions- , raise, raiseStatus, throw, rescue, next, finish, defaultHandler, liftAndCatchIO+ , Lazy.raise, Lazy.raiseStatus, throw, rescue, next, finish, defaultHandler, liftAndCatchIO+ , liftIO, catch , StatusError(..)+ , ScottyException(..) -- * Parsing Parameters , Param, Parsable(..), readEither -- * Types- , RoutePattern, File, Kilobytes, ErrorHandler, Handler(..)+ , RoutePattern, File, Content(..), Kilobytes, ErrorHandler, Handler(..) -- * Monad Transformers , ScottyT, ActionT , ScottyState, defaultScottyState ) where import Blaze.ByteString.Builder (fromByteString)+import Blaze.ByteString.Builder.Char8 (fromString) import Control.Exception (assert) import Control.Monad (when) import Control.Monad.State.Strict (execState, modify) import Control.Monad.IO.Class -import Network.HTTP.Types (status404)+import Network.HTTP.Types (status404, status413, status500) import Network.Socket (Socket) import qualified Network.Wai as W (Application, Middleware, Response, responseBuilder) import Network.Wai.Handler.Warp (Port, runSettings, runSettingsSocket, setPort, getPort) import Web.Scotty.Action import Web.Scotty.Route-import Web.Scotty.Internal.Types (ActionT(..), ScottyT(..), defaultScottyState, Application, RoutePattern, Options(..), defaultOptions, RouteOptions(..), defaultRouteOptions, ErrorHandler, Kilobytes, File, addMiddleware, setHandler, updateMaxRequestBodySize, routes, middlewares, ScottyException(..), ScottyState, defaultScottyState, StatusError(..))+import Web.Scotty.Internal.Types (ScottyT(..), defaultScottyState, Application, RoutePattern, Options(..), defaultOptions, RouteOptions(..), defaultRouteOptions, ErrorHandler, Kilobytes, File, addMiddleware, setHandler, updateMaxRequestBodySize, routes, middlewares, ScottyException(..), ScottyState, defaultScottyState, StatusError(..), Content(..))+import Web.Scotty.Trans.Lazy as Lazy import Web.Scotty.Util (socketDescription) import Web.Scotty.Body (newBodyInfo)-import Web.Scotty.Exceptions (Handler(..), catches) +import UnliftIO.Exception (Handler(..), catch)++ -- | Run a scotty application using the warp server. -- NB: scotty p === scottyT p id scottyT :: (Monad m, MonadIO n)@@ -112,10 +129,19 @@ let s = execState (runS defs) defaultScottyState let rapp req callback = do bodyInfo <- newBodyInfo req- resp <- runActionToIO (applyAll notFoundApp ([midd bodyInfo | midd <- routes s]) req) `catches` [scottyExceptionHandler]+ resp <- runActionToIO (applyAll notFoundApp ([midd bodyInfo | midd <- routes s]) req)+ `catch` unhandledExceptionHandler callback resp return $ applyAll rapp (middlewares s) +--- | Exception handler in charge of 'ScottyException' that's not caught by 'scottyExceptionHandler'+unhandledExceptionHandler :: MonadIO m => ScottyException -> m W.Response+unhandledExceptionHandler = \case+ RequestTooLarge -> return $ W.responseBuilder status413 ct "Request is too big Jim!"+ e -> return $ W.responseBuilder status500 ct $ "Internal Server Error: " <> fromString (show e)+ where+ ct = [("Content-Type", "text/plain")]+ applyAll :: Foldable t => a -> t (a -> a) -> a applyAll = foldl (flip ($)) @@ -127,13 +153,6 @@ defaultHandler :: (Monad m) => ErrorHandler m -> ScottyT m () defaultHandler f = ScottyT $ modify $ setHandler $ Just f --- | Exception handler in charge of 'ScottyException'-scottyExceptionHandler :: MonadIO m => Handler m W.Response-scottyExceptionHandler = Handler $ \case- RequestException ebody s -> do- return $ W.responseBuilder s [("Content-Type", "text/plain")] (fromByteString ebody)-- -- | Use given middleware. Middleware is nested such that the first declared -- is the outermost middleware (it has first dibs on the request and last action -- on the response). Every middleware is run on each request.@@ -146,3 +165,4 @@ setMaxRequestBodySize :: Kilobytes -- ^ Request size limit -> ScottyT m () setMaxRequestBodySize i = assert (i > 0) $ ScottyT . modify . updateMaxRequestBodySize $ defaultRouteOptions { maxRequestBodySize = Just i }+
+ Web/Scotty/Trans/Lazy.hs view
@@ -0,0 +1,61 @@+module Web.Scotty.Trans.Lazy where++import Control.Monad (join)+import Control.Monad.IO.Class+import Data.Bifunctor (bimap)+import qualified Data.Text.Lazy as T+ +import Network.HTTP.Types (Status)++import qualified Web.Scotty.Action as Base+import Web.Scotty.Internal.Types++-- | Throw a "500 Server Error" 'StatusError', which can be caught with 'rescue'.+--+-- Uncaught exceptions turn into HTTP 500 responses.+raise :: (MonadIO m) =>+ T.Text -- ^ Error text+ -> ActionT m a+raise = Base.raise . T.toStrict+{-# DEPRECATED raise "Throw an exception instead" #-}++-- | Throw a 'StatusError' exception that has an associated HTTP error code and can be caught with 'rescue'.+--+-- Uncaught exceptions turn into HTTP responses corresponding to the given status.+raiseStatus :: Monad m => Status -> T.Text -> ActionT m a+raiseStatus s = Base.raiseStatus s . T.toStrict+{-# DEPRECATED raiseStatus "Use status, text, and finish instead" #-}++-- | Redirect to given URL. Like throwing an uncatchable exception. Any code after the call to redirect+-- will not be run.+--+-- > redirect "http://www.google.com"+--+-- OR+--+-- > redirect "/foo/bar"+redirect :: (Monad m) => T.Text -> ActionT m a+redirect = Base.redirect . T.toStrict++-- | Get a request header. Header name is case-insensitive.+header :: (Monad m) => T.Text -> ActionT m (Maybe T.Text)+header h = fmap T.fromStrict <$> Base.header (T.toStrict h)++-- | Get all the request headers. Header names are case-insensitive.+headers :: (Monad m) => ActionT m [(T.Text, T.Text)]+headers = map (join bimap T.fromStrict) <$> Base.headers++-- | Add to the response headers. Header names are case-insensitive.+addHeader :: MonadIO m => T.Text -> T.Text -> ActionT m ()+addHeader k v = Base.addHeader (T.toStrict k) (T.toStrict v)++-- | Set one of the response headers. Will override any previously set value for that header.+-- Header names are case-insensitive.+setHeader :: MonadIO m => T.Text -> T.Text -> ActionT m ()+setHeader k v = Base.addHeader (T.toStrict k) (T.toStrict v)++text :: (MonadIO m) => T.Text -> ActionT m ()+text = Base.textLazy++html :: (MonadIO m) => T.Text -> ActionT m ()+html = Base.htmlLazy
+ Web/Scotty/Trans/Strict.hs view
@@ -0,0 +1,56 @@+-- | This module is essentially identical to 'Web.Scotty.Trans', except that +-- some functions take/return strict Text instead of the lazy ones.+--+-- It should be noted that most of the code snippets below depend on the+-- OverloadedStrings language pragma.+--+-- The functions in this module allow an arbitrary monad to be embedded+-- in Scotty's monad transformer stack in order that Scotty be combined+-- with other DSLs.+--+-- Scotty is set up by default for development mode. For production servers,+-- you will likely want to modify 'settings' and the 'defaultHandler'. See+-- the comments on each of these functions for more information.+module Web.Scotty.Trans.Strict+ ( -- * scotty-to-WAI+ scottyT, scottyAppT, scottyOptsT, scottySocketT, Options(..), defaultOptions+ -- * Defining Middleware and Routes+ --+ -- | '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, setMaxRequestBodySize+ -- ** Route Patterns+ , capture, regex, function, literal+ -- ** Accessing the Request, Captures, and Query Parameters+ , request, Base.header, Base.headers, body, bodyReader+ , param, params+ , captureParam, formParam, queryParam+ , captureParamMaybe, formParamMaybe, queryParamMaybe+ , captureParams, formParams, queryParams+ , jsonData, files+ -- ** Modifying the Response and Redirecting+ , status, Base.addHeader, Base.setHeader, Base.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.+ , Base.text, Base.html, file, json, stream, raw, nested+ , textLazy+ , htmlLazy+ -- ** Accessing the fields of the Response+ , getResponseHeaders, getResponseStatus, getResponseContent+ -- ** Exceptions+ , Base.raise, Base.raiseStatus, throw, rescue, next, finish, defaultHandler, liftAndCatchIO+ , StatusError(..)+ , ScottyException(..)+ -- * Parsing Parameters+ , Param, Parsable(..), readEither+ -- * Types+ , RoutePattern, File, Content(..), Kilobytes, ErrorHandler, Handler(..)+ -- * Monad Transformers+ , ScottyT, ActionT+ , ScottyState, defaultScottyState+ ) where+import Web.Scotty.Action as Base+import Web.Scotty.Trans
Web/Scotty/Util.hs view
@@ -1,7 +1,10 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-}+{-# options_ghc -Wno-unused-imports #-} module Web.Scotty.Util ( lazyTextToStrictByteString , strictByteStringToLazyText+ , decodeUtf8Lenient , mkResponse , replace , add@@ -13,16 +16,12 @@ import Network.Socket (SockAddr(..), Socket, getSocketName, socketPort) import Network.Wai +import Control.Exception import Control.Monad (when)-import qualified Control.Exception as EUnsafe (throw)---import Network.HTTP.Types- import qualified Data.ByteString as B-import qualified Data.Text as TP (pack)+import qualified Data.Text as TP (Text, pack) import qualified Data.Text.Lazy as TL-import qualified Data.Text.Encoding as ES+import Data.Text.Encoding as ES import qualified Data.Text.Encoding.Error as ES import Web.Scotty.Internal.Types@@ -33,7 +32,10 @@ strictByteStringToLazyText :: B.ByteString -> TL.Text strictByteStringToLazyText = TL.fromStrict . ES.decodeUtf8With ES.lenientDecode -+#if !MIN_VERSION_text(2,0,0)+decodeUtf8Lenient :: B.ByteString -> TP.Text+decodeUtf8Lenient = ES.decodeUtf8With ES.lenientDecode+#endif -- Note: we currently don't support responseRaw, which may be useful -- for websockets. However, we always read the request body, which@@ -92,7 +94,7 @@ readUntilEmpty = do b <- rbody if B.null b- then EUnsafe.throw (RequestException (ES.encodeUtf8 . TP.pack $ "Request is too big Jim!") status413)+ then throwIO RequestTooLarge else readUntilEmpty
changelog.md view
@@ -1,11 +1,33 @@ ## next [????.??.??] -## 0.20.1 [2023.10.03] +## 0.21 [2023.12.17]+### New+* add `getResponseHeaders`, `getResponseStatus`, `getResponseContent` (#214)+* add `captureParamMaybe`, `formParamMaybe`, `queryParamMaybe` (#322)+* add `Web.Scotty.Trans.Strict` and `Web.Scotty.Trans.Lazy` (#334)+* renamed `captureParam`, `captureParamMaybe`, and `captureParams` to `pathParam`, `pathParamMaybe`, `pathParams` respectively, keeping the old names as their synonyms (#344)++### Deprecated+* deprecate `rescue` and `liftAndCatchIO` (#332)+* Deprecate `StatusError`, `raise` and `raiseStatus` (#351)++### Fixes+* Reverted the `MonadReader` instance of `ActionT` so that it inherits the base monad (#342)+* Scotty's API such as `queryParam` now throws `ScottyException` rather than `StatusException`.+ Uncaught exceptions are handled by `scottyExceptionHandler`, resembling the existing behaviour++### Documentation+* Add doctest, refactor some inline examples into doctests (#353)+* document "`defaultHandler` only applies to endpoints defined after it" (#237)+++## 0.20.1 [2023.10.03] * remove dependencies on 'base-compat' and 'base-compat-batteries' (#318) * re-add MonadFail (ActionT m) instance (#325) * re-add MonadError (ActionT m) instance, but the error type is now specialized to 'StatusError' (#325) * raise lower bound on base ( > 4.14 ) to reflect support for GHC >= 8.10 (#325).+ ## 0.20 [2023.10.02] * Drop support for GHC < 8.10 and modernise the CI pipeline (#300).
+ doctest/Main.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE CPP #-}+module Main where++#if __GLASGOW_HASKELL__ >= 946+import Test.DocTest (doctest)++-- 1. Our current doctests require a number of imports that scotty doesn't need+-- 2. declaring doctest helper functions in this module doesn't seem to work+-- 3. cabal tests cannot have exposed modules?+-- 4. GHCi only started supporting multiline imports since 9.4.6 ( https://gitlab.haskell.org/ghc/ghc/-/issues/20473 )+-- so lacking a better option we no-op doctest for older GHCs++main :: IO ()+main = doctest [+ "Web/Scotty.hs"+ , "Web/Scotty/Trans.hs"+ , "-XOverloadedStrings"+ , "-XLambdaCase"+ ]+#else+main :: IO ()+main = pure ()+#endif
examples/basic.hs view
@@ -35,12 +35,22 @@ get "/" $ text "foobar" get "/" $ text "barfoo" - -- Using a parameter in the query string. Since it has- -- not been given, a 500 page is generated.- get "/foo" $ do- v <- captureParam "fooparam"+ -- Looking for a parameter in the path. Since the path pattern does not+ -- contain the parameter name 'p', the server responds with 500 Server Error.+ get "/foo_fail" $ do+ v <- pathParam "p" html $ mconcat ["<h1>", v, "</h1>"] + -- Looking for a parameter 'p' in the path.+ get "/foo_path/:p" $ do+ v <- pathParam "p"+ html $ mconcat ["<h1>", v, "</h1>"]++ -- Looking for a parameter 'p' in the query string.+ get "/foo_query" $ do+ v <- queryParam "p"+ html $ mconcat ["<h1>", v, "</h1>"]+ -- An uncaught error becomes a 500 page. get "/raise" $ throw Boom @@ -58,13 +68,13 @@ -- Of course you can catch your own errors. get "/rescue" $ do (do void $ throw Boom; redirect "http://www.we-never-go-here.com")- `rescue` (\(e :: Err) -> text $ "we recovered from " `mappend` pack (show e))+ `catch` (\(e :: Err) -> text $ "we recovered from " `mappend` pack (show e)) -- Parts of the URL that start with a colon match -- any string, and capture that value as a parameter. -- URL captures take precedence over query string parameters. get "/foo/:bar/required" $ do- v <- captureParam "bar"+ v <- pathParam "bar" html $ mconcat ["<h1>", v, "</h1>"] -- Files are streamed directly to the client.@@ -81,7 +91,7 @@ json $ take 20 $ randomRs (1::Int,100) g get "/ints/:is" $ do- is <- captureParam "is"+ is <- pathParam "is" json $ [(1::Int)..10] ++ is get "/setbody" $ do
examples/cookies.hs view
@@ -33,7 +33,7 @@ H.input H.! type_ "submit" H.! value "set a cookie" post "/set-a-cookie" $ do- name' <- captureParam "name"- value' <- captureParam "value"+ name' <- pathParam "name"+ value' <- pathParam "value" setSimpleCookie name' value' redirect "/"
examples/exceptions.hs view
@@ -5,6 +5,7 @@ import Control.Exception (Exception(..)) import Control.Monad.IO.Class+import Control.Monad.IO.Unlift (MonadUnliftIO(..)) import Data.String (fromString) import Data.Typeable@@ -34,8 +35,12 @@ html $ fromString $ "<h1>" ++ s ++ "</h1>" main :: IO ()-main = scottyT 3000 id $ do -- note, we aren't using any additional transformer layers- -- so we can just use 'id' for the runner.+main = do+ scottyT 3000 id server -- note: we use 'id' since we don't have to run any effects at each action++-- Any custom monad stack will need to implement 'MonadUnliftIO'+server :: MonadUnliftIO m => ScottyT m ()+server = do middleware logStdoutDev defaultHandler handleEx -- define what to do with uncaught exceptions@@ -49,7 +54,7 @@ ] get "/switch/:val" $ do- v <- captureParam "val"+ v <- pathParam "val" _ <- if even v then throw Forbidden else throw (NotFound v) text "this will never be reached" @@ -58,4 +63,4 @@ i <- liftIO randomIO let catchOne Forbidden = html "<h1>Forbidden was randomly thrown, but we caught it." catchOne other = throw other- throw (if rBool then Forbidden else NotFound i) `rescue` catchOne+ throw (if rBool then Forbidden else NotFound i) `catch` catchOne
examples/upload.hs view
@@ -4,6 +4,7 @@ import Web.Scotty import Control.Monad.IO.Class+import qualified Data.Text.Lazy as TL import Network.Wai.Middleware.RequestLogger import Network.Wai.Middleware.Static@@ -39,7 +40,7 @@ -- write the files to disk, so they will be served by the static middleware liftIO $ sequence_ [ B.writeFile ("uploads" </> fn) fc | (_,fn,fc) <- fs' ] -- generate list of links to the files just uploaded- html $ mconcat [ mconcat [ fName+ html $ mconcat [ mconcat [ TL.fromStrict fName , ": " , renderHtml $ H.a (H.toHtml fn) H.! (href $ H.toValue fn) >> H.br ]
examples/urlshortener.hs view
@@ -49,7 +49,7 @@ H.input H.! type_ "submit" post "/shorten" $ do- url <- captureParam "url"+ url <- formParam "url" liftIO $ modifyMVar_ m $ \(i,db) -> return (i+1, M.insert i (T.pack url) db) redirect "/list"
scotty.cabal view
@@ -1,5 +1,5 @@ Name: scotty-Version: 0.20.1+Version: 0.21 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@@ -22,7 +22,7 @@ . main = scotty 3000 $   get "/:word" $ do-     beam <- captureParam "word"+     beam <- pathParam "word"     html $ mconcat ["<h1>Scotty, ", beam, " me up!</h1>"] @ .@@ -47,6 +47,7 @@ , GHC == 9.2.8 , GHC == 9.4.6 , GHC == 9.6.2+ , GHC == 9.6.3 Extra-source-files: README.md changelog.md@@ -60,18 +61,19 @@ Library Exposed-modules: Web.Scotty Web.Scotty.Trans+ Web.Scotty.Trans.Strict Web.Scotty.Internal.Types Web.Scotty.Cookie other-modules: Web.Scotty.Action Web.Scotty.Body- Web.Scotty.Exceptions Web.Scotty.Route+ Web.Scotty.Trans.Lazy Web.Scotty.Util default-language: Haskell2010 build-depends: aeson >= 0.6.2.1 && < 2.3, base >= 4.14 && < 5, blaze-builder >= 0.3.3.0 && < 0.5,- bytestring >= 0.10.0.2 && < 0.12,+ bytestring >= 0.10.0.2 && < 0.13, case-insensitive >= 1.0.0.1 && < 1.3, cookie >= 0.4, data-default-class >= 0.1,@@ -120,6 +122,21 @@ wai build-tool-depends: hspec-discover:hspec-discover == 2.* GHC-options: -Wall -threaded -fno-warn-orphans++test-suite doctest+ main-is: Main.hs+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ GHC-options: -Wall -threaded -fno-warn-orphans+ hs-source-dirs: doctest+ build-depends: base+ , bytestring+ , doctest >= 0.20.1+ , http-client+ , http-types+ , scotty+ , text+ , wai benchmark weigh main-is: Main.hs
test/Web/ScottySpec.hs view
@@ -11,7 +11,7 @@ import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TLE import Network.HTTP.Types-import Network.Wai (Application, responseLBS)+import Network.Wai (Application, Request(queryString), responseLBS) import qualified Control.Exception.Lifted as EL import qualified Control.Exception as E @@ -56,6 +56,10 @@ it ("properly handles extra slash routes for " ++ method ++ " requests") $ do makeRequest "//scotty" `shouldRespondWith` 200 + withApp (route "/:paramName" $ captureParam "paramName" >>= text) $ do+ it ("captures route parameters for " ++ method ++ " requests with url encoded '/' in path") $ do+ makeRequest "/a%2Fb" `shouldRespondWith` "a/b"+ describe "addroute" $ do forM_ availableMethods $ \method -> do withApp (addroute method "/scotty" $ html "") $ do@@ -92,14 +96,31 @@ withApp (do let h = Handler (\(_ :: E.ArithException) -> status status503) defaultHandler h- Scotty.get "/" (liftAndCatchIO $ E.throwIO E.DivideByZero)) $ do+ Scotty.get "/" (liftIO $ E.throwIO E.DivideByZero)) $ do it "allows to customize the HTTP status code" $ do get "/" `shouldRespondWith` "" {matchStatus = 503}+ withApp (do+ let h = Handler (\(_ :: E.SomeException) -> setHeader "Location" "/c" >> status status500)+ defaultHandler h+ Scotty.get "/a" (redirect "/b")) $ do+ it "should give priority to actionErrorHandlers" $ do+ get "/a" `shouldRespondWith` 302 { matchHeaders = ["Location" <:> "/b"] } context "when not specified" $ do withApp (Scotty.get "/" $ throw E.DivideByZero) $ do it "returns 500 on exceptions" $ do get "/" `shouldRespondWith` "" {matchStatus = 500}+ context "only applies to endpoints defined after it (#237)" $ do+ withApp (do+ let h = Handler (\(_ :: E.SomeException) -> status status503 >> text "ok")+ Scotty.get "/a" (throw E.DivideByZero)+ defaultHandler h+ Scotty.get "/b" (throw E.DivideByZero)+ ) $ do+ it "doesn't catch an exception before the handler is set" $ do+ get "/a" `shouldRespondWith` 500+ it "catches an exception after the handler is set" $ do+ get "/b" `shouldRespondWith` "ok" {matchStatus = 503} describe "setMaxRequestBodySize" $ do@@ -119,7 +140,17 @@ request "POST" "/" [("Content-Type","multipart/form-data; boundary=--33")] large `shouldRespondWith` 200 + describe "middleware" $ do+ context "can rewrite the query string (#348)" $ do+ withApp (do+ Scotty.middleware $ \app req sendResponse ->+ app req{queryString = [("query", Just "haskell")]} sendResponse+ Scotty.matchAny "/search" $ queryParam "query" >>= text+ ) $ do+ it "returns query parameter with given name" $ do+ get "/search" `shouldRespondWith` "haskell" + describe "ActionM" $ do context "MonadBaseControl instance" $ do withApp (Scotty.get "/" $ (undefined `EL.catch` ((\_ -> html "") :: E.SomeException -> ActionM ()))) $ do@@ -145,7 +176,7 @@ withApp (Scotty.get "/" $ fail "boom!") $ do it "returns 500 if not caught" $ get "/" `shouldRespondWith` 500- withApp (Scotty.get "/" $ (fail "boom!") `rescue` (\(_ :: StatusError) -> text "ok")) $+ withApp (Scotty.get "/" $ (fail "boom!") `catch` (\(_ :: StatusError) -> text "ok")) $ it "can catch the StatusError thrown by fail" $ do get "/" `shouldRespondWith` 200 { matchBody = "ok"} @@ -188,7 +219,7 @@ get "/search/potato" `shouldRespondWith` 500 context "recover from missing parameter exception" $ do withApp (Scotty.get "/search/:q" $- (captureParam "z" >>= text) `rescue` (\(_::StatusError) -> text "z")+ (captureParam "z" >>= text) `catch` (\(_::ScottyException) -> text "z") ) $ do it "catches a StatusError" $ do get "/search/xxx" `shouldRespondWith` 200 { matchBody = "z"}@@ -206,9 +237,9 @@ get "/search?query=potato" `shouldRespondWith` 400 context "recover from type mismatch parameter exception" $ do withApp (Scotty.get "/search" $- (queryParam "z" >>= (\v -> json (v :: Int))) `rescue` (\(_::StatusError) -> text "z")+ (queryParam "z" >>= (\v -> json (v :: Int))) `catch` (\(_::ScottyException) -> text "z") ) $ do- it "catches a StatusError" $ do+ it "catches a ScottyException" $ do get "/search?query=potato" `shouldRespondWith` 200 { matchBody = "z"} describe "formParam" $ do@@ -238,10 +269,30 @@ postForm "/" "p=42" `shouldRespondWith` "42" context "recover from type mismatch parameter exception" $ do withApp (Scotty.post "/search" $- (formParam "z" >>= (\v -> json (v :: Int))) `rescue` (\(_::StatusError) -> text "z")+ (formParam "z" >>= (\v -> json (v :: Int))) `catch` (\(_::ScottyException) -> text "z") ) $ do it "catches a StatusError" $ do postForm "/search" "z=potato" `shouldRespondWith` 200 { matchBody = "z"}++ describe "captureParamMaybe" $ do+ withApp (+ do+ Scotty.get "/a/:q" $ do+ mx <- captureParamMaybe "q"+ case mx of+ Just (_ :: Int) -> status status200+ Nothing -> status status500+ Scotty.get "/b/:q" $ do+ mx <- captureParamMaybe "z"+ case mx of+ Just (_ :: TL.Text) -> text "impossible" >> status status500+ Nothing -> status status200+ ) $ do+ it "responds with 200 OK if the parameter can be parsed at the right type, 500 otherwise" $ do+ get "/a/potato" `shouldRespondWith` 500+ get "/a/42" `shouldRespondWith` 200+ it "responds with 200 OK if the parameter is not found" $ do+ get "/b/potato" `shouldRespondWith` 200 describe "text" $ do