From 3eaa4a22d846dc70ca01fa63ac6abb79f3988b68 Mon Sep 17 00:00:00 2001 From: Marco Zocca Date: Mon, 2 Oct 2023 04:57:59 +0200 Subject: [PATCH] example programs fixed --- Web/Scotty.hs | 2 +- Web/Scotty/Action.hs | 8 ++------ Web/Scotty/Internal/Types.hs | 20 ++++++++++++-------- Web/Scotty/Trans.hs | 3 ++- Web/Scotty/Util.hs | 1 + changelog.md | 16 +++++++++++----- examples/basic.hs | 20 +++++++++++++++----- examples/exceptions.hs | 25 ++++++++++++------------- examples/options.hs | 7 +++---- examples/urlshortener.hs | 14 ++++++++++++-- scotty.cabal | 3 --- 11 files changed, 71 insertions(+), 48 deletions(-) diff --git a/Web/Scotty.hs b/Web/Scotty.hs index 177c6a4b..376264eb 100644 --- a/Web/Scotty.hs +++ b/Web/Scotty.hs @@ -148,7 +148,7 @@ finish = Trans.finish -- | Catch an exception thrown by 'raise'. -- --- > raise "just kidding" `rescue` (\msg -> text msg) +-- > raise JustKidding `rescue` (\msg -> text msg) rescue :: E.Exception e => ActionM a -> (e -> ActionM a) -> ActionM a rescue = Trans.rescue diff --git a/Web/Scotty/Action.hs b/Web/Scotty/Action.hs index 61ef054d..845bcb60 100644 --- a/Web/Scotty/Action.hs +++ b/Web/Scotty/Action.hs @@ -65,7 +65,6 @@ import Data.Bool (bool) import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as BL import qualified Data.CaseInsensitive as CI -import Data.Default.Class (def) import Data.Int import Data.String (IsString(..)) import qualified Data.Text as ST @@ -177,7 +176,7 @@ raiseStatus s = E.throw . StatusError s -- > text "You made a request to /foo/special" -- > -- > get "/foo/:baz" $ do --- > w <- param "baz" +-- > w <- captureParam "baz" -- > text $ "You made a request to: " <> w next :: (Monad m) => ActionT m a next = E.throw Next @@ -296,7 +295,6 @@ param k = do -- * 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. -- -- * If the parameter is found, but 'parseParam' fails to parse to the correct type, 'next' is called. --- captureParam :: (Parsable a, ScottyError e, Monad m) => T.Text -> ActionT e m a captureParam :: (Parsable a, Monad m) => T.Text -> ActionT m a captureParam = paramWith CaptureParam envCaptureParams status500 @@ -305,7 +303,6 @@ captureParam = paramWith CaptureParam envCaptureParams status500 -- * 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. -- -- * This function raises a code 400 also if the parameter is found, but 'parseParam' fails to parse to the correct type. --- formParam :: (Parsable a, ScottyError e, Monad m) => T.Text -> ActionT e m a formParam :: (Parsable a, Monad m) => T.Text -> ActionT m a formParam = paramWith FormParam envFormParams status400 @@ -314,7 +311,6 @@ formParam = paramWith FormParam envFormParams status400 -- * 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. -- -- * This function raises a code 400 also if the parameter is found, but 'parseParam' fails to parse to the correct type. --- queryParam :: (Parsable a, ScottyError e, Monad m) => T.Text -> ActionT e m a queryParam :: (Parsable a, Monad m) => T.Text -> ActionT m a queryParam = paramWith QueryParam envQueryParams status400 @@ -428,7 +424,7 @@ readEither t = case [ x | (x,"") <- reads (T.unpack t) ] of [] -> Left "readEither: no parse" _ -> Left "readEither: ambiguous parse" --- | Set the HTTP response status. Default is 200. +-- | Set the HTTP response status. status :: MonadIO m => Status -> ActionT m () status = modifyResponse . setStatus diff --git a/Web/Scotty/Internal/Types.hs b/Web/Scotty/Internal/Types.hs index d3315d84..6810ce52 100644 --- a/Web/Scotty/Internal/Types.hs +++ b/Web/Scotty/Internal/Types.hs @@ -97,7 +97,7 @@ data BodyInfo = BodyInfo { bodyInfoReadProgress :: MVar Int -- ^ index into the data ScottyState m = ScottyState { middlewares :: [Wai.Middleware] , routes :: [BodyInfo -> Middleware m] - , handler :: Maybe (ErrorHandler m) -- Maybe (AErr -> ActionT m ()) -- ErrorHandler e m + , handler :: Maybe (ErrorHandler m) , routeOptions :: RouteOptions } @@ -124,19 +124,22 @@ newtype ScottyT m a = ScottyT { runS :: State (ScottyState m) a } ------------------ Scotty Errors -------------------- +-- | Internal exception mechanism used to modify the request processing flow. +-- +-- The exception constructor is not exposed to the user and all exceptions of this type are caught +-- and processed within the 'runAction' function. data ActionError - = Redirect Text - | Next - | Finish - | StatusError Status Text -- e.g. 422 Unprocessable Entity when JSON body parsing fails + = Redirect Text -- ^ Redirect + | Next -- ^ Stop processing this route and skip to the next one + | Finish -- ^ Stop processing the request + | StatusError Status Text -- ^ e.g. 422 Unprocessable Entity when JSON body parsing fails deriving (Show, Typeable) instance E.Exception ActionError - - +-- | Specializes a 'Handler' to the 'ActionT' monad type ErrorHandler m = Handler (ActionT m) () --- type ErrorHandler e m = Maybe (e -> ActionT e m ()) +-- | Thrown e.g. when a request is too large data ScottyException = RequestException BS.ByteString Status deriving (Show, Typeable) instance E.Exception ScottyException @@ -186,6 +189,7 @@ setHeaderWith f sr = sr { srHeaders = f (srHeaders sr) } setStatus :: Status -> ScottyResponse -> ScottyResponse setStatus s sr = sr { srStatus = s } +-- | The default response has code 200 OK and empty body defaultScottyResponse :: ScottyResponse defaultScottyResponse = SR status200 [] (ContentBuilder mempty) diff --git a/Web/Scotty/Trans.hs b/Web/Scotty/Trans.hs index 79b84d6e..64435c0c 100644 --- a/Web/Scotty/Trans.hs +++ b/Web/Scotty/Trans.hs @@ -38,7 +38,7 @@ module Web.Scotty.Trans -- * Parsing Parameters , Param, Parsable(..), readEither -- * Types - , RoutePattern, File, Kilobytes + , RoutePattern, File, Kilobytes, ErrorHandler, Handler(..) -- * Monad Transformers , ScottyT, ActionT ) where @@ -63,6 +63,7 @@ import Web.Scotty.Internal.Types hiding (Application, Middleware) import Web.Scotty.Util (socketDescription) import qualified Web.Scotty.Internal.Types as Scotty import Web.Scotty.Body (newBodyInfo) +import Web.Scotty.Exceptions (Handler(..)) -- | Run a scotty application using the warp server. -- NB: scotty p === scottyT p id diff --git a/Web/Scotty/Util.hs b/Web/Scotty/Util.hs index 87dacf9a..a21769fd 100644 --- a/Web/Scotty/Util.hs +++ b/Web/Scotty/Util.hs @@ -1,4 +1,5 @@ {-# LANGUAGE LambdaCase #-} +{-# options_ghc -Wno-unused-imports #-} module Web.Scotty.Util ( lazyTextToStrictByteString , strictByteStringToLazyText diff --git a/changelog.md b/changelog.md index 1b68538f..09b0ce9c 100644 --- a/changelog.md +++ b/changelog.md @@ -1,10 +1,16 @@ ## next [????.??.??] -* Adds a new `nested` handler that allows you to place an entire WAI Application under a Scotty route -* Disambiguate request parameters (#204). Adjust the `Env` type to have three [Param] fields instead of one, add `captureParam`, `formParam`, `queryParam` and the associated `captureParams`, `formParams`, `queryParams`. Add deprecation notices to `param` and `params`. -* Add `Scotty.Cookie` module. -* Change body parsing behaviour such that calls to 'next' don't result in POST request bodies disappearing (#147). -* (Internal) Remove unused type RequestBodyState (#313) +* Drop support for GHC < 8.10 and modernise the CI pipeline (#300). +* Adds a new `nested` handler that allows you to place an entire WAI Application under a Scotty route (#233). +* Disambiguate request parameters (#204). Adjust the `Env` type to have three `[Param]` fields instead of one, add `captureParam`, `formParam`, `queryParam` and the associated `captureParams`, `formParams`, `queryParams`. Add deprecation notices to `param` and `params`. +* Add `Scotty.Cookie` module (#293). +* Change body parsing behaviour such that calls to `next` don't result in POST request bodies disappearing (#147). +* (Internal) Remove unused type `RequestBodyState` (#313) + +### Breaking: * Get rid of data-default-class (#316) https://markkarpov.com/post/data-default.html +* (#314) Rewrite `ActionT` as a `ReaderT`-over-`IO` (using the "ReaderT pattern" : https://www.fpcomplete.com/blog/readert-design-pattern/ ) +* (#314) Introduce `unliftio-core` as a dependency, and base exception handling on methods copied from `unliftio` e.g. `catch`. +* (#314) All ActionT methods (`text`, `html` etc.) have now a MonadIO constraint on the base monad rather than Monad. `rescue` has a MonadUnliftIO constraint. The Alternative instance of ActionT also is based on MonadIO because `next` is implemented in terms of `throw`. ## 0.12.1 [2022.11.17] * Fix CPP bug that prevented tests from building on Windows. diff --git a/examples/basic.hs b/examples/basic.hs index 1fcac1dd..bb91f496 100644 --- a/examples/basic.hs +++ b/examples/basic.hs @@ -1,21 +1,29 @@ {-# LANGUAGE OverloadedStrings #-} +{-# language DeriveAnyClass #-} +{-# language ScopedTypeVariables #-} module Main (main) where import Web.Scotty import Network.Wai.Middleware.RequestLogger -- install wai-extra if you don't have this +import Control.Exception (Exception(..)) import Control.Monad import Control.Monad.Trans import System.Random (newStdGen, randomRs) import Network.HTTP.Types (status302) +import Data.Text.Lazy (pack) import Data.Text.Lazy.Encoding (decodeUtf8) import Data.String (fromString) +import Data.Typeable (Typeable) import Prelude () import Prelude.Compat +data Err = Boom | UserAgentNotFound | NeverReached deriving (Show, Typeable, Exception) + + main :: IO () main = scotty 3000 $ do -- Add any WAI middleware, they are run top-down. @@ -36,7 +44,7 @@ main = scotty 3000 $ do html $ mconcat ["

", v, "

"] -- An uncaught error becomes a 500 page. - get "/raise" $ raise "some error here" + get "/raise" $ raise Boom -- You can set status and headers directly. get "/redirect-custom" $ do @@ -47,12 +55,12 @@ main = scotty 3000 $ do -- redirects preempt execution get "/redirect" $ do void $ redirect "http://www.google.com" - raise "this error is never reached" + raise NeverReached -- Of course you can catch your own errors. get "/rescue" $ do - (do void $ raise "a rescued error"; redirect "http://www.we-never-go-here.com") - `rescue` (\m -> text $ "we recovered from " `mappend` aErrText m) + (do void $ raise Boom; redirect "http://www.we-never-go-here.com") + `rescue` (\(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. @@ -85,13 +93,15 @@ main = scotty 3000 $ do ,"" ] + -- Read and decode the request body as UTF-8 post "/readbody" $ do b <- body text $ decodeUtf8 b + -- Look up a request header get "/header" $ do agent <- header "User-Agent" - maybe (raise "User-Agent header not found!") text agent + maybe (raise UserAgentNotFound) text agent -- Make a request to this URI, then type a line in the terminal, which -- will be the response. Using ctrl-c will cause getLine to fail. diff --git a/examples/exceptions.hs b/examples/exceptions.hs index cb42b32b..bda8240e 100644 --- a/examples/exceptions.hs +++ b/examples/exceptions.hs @@ -1,9 +1,13 @@ {-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving, ScopedTypeVariables #-} +{-# language DeriveAnyClass #-} +{-# language LambdaCase #-} module Main (main) where +import Control.Exception (Exception(..)) import Control.Monad.IO.Class import Data.String (fromString) +import Data.Typeable import Network.HTTP.Types import Network.Wai.Middleware.RequestLogger @@ -15,25 +19,20 @@ import System.Random import Web.Scotty.Trans --- Define a custom exception type. +-- | A custom exception type. data Except = Forbidden | NotFound Int | StringEx String - deriving (Show, Eq) + deriving (Show, Eq, Typeable, Exception) --- The type must be an instance of 'ScottyError'. --- 'ScottyError' is essentially a combination of 'Error' and 'Show'. -instance ScottyError Except where - stringError = StringEx - showError = fromString . show - --- Handler for uncaught exceptions. -handleEx :: Monad m => Except -> ActionT m () -handleEx Forbidden = do +-- | User-defined exceptions should have an associated Handler: +handleEx :: MonadIO m => ErrorHandler m +handleEx = Handler $ \case + Forbidden -> do status status403 html "

Scotty Says No

" -handleEx (NotFound i) = do + NotFound i -> do status status404 html $ fromString $ "

Can't find " ++ show i ++ ".

" -handleEx (StringEx s) = do + StringEx s -> do status status500 html $ fromString $ "

" ++ s ++ "

" diff --git a/examples/options.hs b/examples/options.hs index ad4de68e..f29b1116 100644 --- a/examples/options.hs +++ b/examples/options.hs @@ -5,14 +5,13 @@ import Web.Scotty import Network.Wai.Middleware.RequestLogger -- install wai-extra if you don't have this -import Data.Default.Class (def) import Network.Wai.Handler.Warp (setPort) -- Set some Scotty settings opts :: Options -opts = def { verbose = 0 - , settings = setPort 4000 $ settings def - } +opts = defaultOptions { verbose = 0 + , settings = setPort 4000 $ settings defaultOptions + } -- This won't display anything at startup, and will listen on localhost:4000 main :: IO () diff --git a/examples/urlshortener.hs b/examples/urlshortener.hs index c6e85e31..6dc6f5ce 100644 --- a/examples/urlshortener.hs +++ b/examples/urlshortener.hs @@ -1,12 +1,17 @@ {-# LANGUAGE OverloadedStrings #-} +{-# language DeriveAnyClass #-} +{-# language LambdaCase #-} +-- {-# language ScopedTypeVariables #-} module Main (main) where import Web.Scotty import Control.Concurrent.MVar +import Control.Exception (Exception(..)) import Control.Monad.IO.Class import qualified Data.Map as M import qualified Data.Text.Lazy as T +import Data.Typeable (Typeable) import Network.Wai.Middleware.RequestLogger import Network.Wai.Middleware.Static @@ -26,9 +31,14 @@ import Text.Blaze.Html.Renderer.Text (renderHtml) -- Implement some kind of session and/or cookies -- Add links +data SessionError = UrlHashNotFound Int deriving (Typeable, Exception) +instance Show SessionError where + show = \case + UrlHashNotFound hash -> unwords ["URL hash #", show hash, " not found in database!"] + main :: IO () main = do - m <- newMVar (0::Int,M.empty :: M.Map Int T.Text) + m <- newMVar (0::Int, M.empty :: M.Map Int T.Text) scotty 3000 $ do middleware logStdoutDev middleware static @@ -55,7 +65,7 @@ main = do hash <- captureParam "hash" (_,db) <- liftIO $ readMVar m case M.lookup hash db of - Nothing -> raise $ mconcat ["URL hash #", T.pack $ show $ hash, " not found in database!"] + Nothing -> raise $ UrlHashNotFound hash Just url -> redirect url -- We put /list down here to show that it will not match the '/:hash' route above. diff --git a/scotty.cabal b/scotty.cabal index 525883c6..5f930dab 100644 --- a/scotty.cabal +++ b/scotty.cabal @@ -77,7 +77,6 @@ Library bytestring >= 0.10.0.2 && < 0.12, case-insensitive >= 1.0.0.1 && < 1.3, cookie >= 0.4, - data-default-class >= 0.0.1 && < 0.2, exceptions >= 0.7 && < 0.11, http-types >= 0.9.1 && < 0.13, monad-control >= 1.0.0.3 && < 1.1, @@ -112,7 +111,6 @@ test-suite spec build-depends: async, base, bytestring, - data-default-class, directory, hspec == 2.*, hspec-wai >= 0.6.3, @@ -137,7 +135,6 @@ benchmark weigh mtl, text, transformers, - data-default-class, weigh >= 0.0.16 && <0.1 GHC-options: -Wall -O2 -threaded