diff --git a/Web/Scotty.hs b/Web/Scotty.hs index b89dcaf1..0d6f9df1 100644 --- a/Web/Scotty.hs +++ b/Web/Scotty.hs @@ -30,13 +30,15 @@ module Web.Scotty -- | Note: only one of these should be present in any given route -- definition, as they completely replace the current 'Response' body. , text, html, file, json, stream, raw + -- ** Accessing the fields of the Response + , getResponseHeaders, getResponseStatus, getResponseContent -- ** Exceptions , raise, raiseStatus, throw, rescue, next, finish, defaultHandler, liftAndCatchIO , StatusError(..) -- * Parsing Parameters , Param, Trans.Parsable(..), Trans.readEither -- * Types - , ScottyM, ActionM, RoutePattern, File, Kilobytes, Handler(..) + , ScottyM, ActionM, RoutePattern, File, Content(..), Kilobytes, Handler(..) , ScottyState, defaultScottyState ) where @@ -48,12 +50,12 @@ import qualified Data.ByteString as BS import Data.ByteString.Lazy.Char8 (ByteString) import Data.Text.Lazy (Text) -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.Internal.Types (ScottyT, ActionT, ErrorHandler, Param, RoutePattern, Options, defaultOptions, File, Kilobytes, ScottyState, defaultScottyState, StatusError(..), Content(..)) import Web.Scotty.Exceptions (Handler(..)) type ScottyM = ScottyT IO @@ -341,6 +343,18 @@ stream = Trans.stream raw :: ByteString -> ActionM () raw = Trans.raw + +-- | Access the HTTP 'Status' of the Response +getResponseStatus :: ActionM Status +getResponseStatus = Trans.getResponseStatus +-- | Access the HTTP headers of the Response +getResponseHeaders :: ActionM ResponseHeaders +getResponseHeaders = Trans.getResponseHeaders +-- | Access the content of the Response +getResponseContent :: ActionM Content +getResponseContent = Trans.getResponseContent + + -- | get = 'addroute' 'GET' get :: RoutePattern -> ActionM () -> ScottyM () get = Trans.get @@ -439,3 +453,7 @@ function = Trans.function -- | Build a route that requires the requested path match exactly, without captures. literal :: String -> RoutePattern literal = Trans.literal + + + + diff --git a/Web/Scotty/Action.hs b/Web/Scotty/Action.hs index 40d1f2c8..7dd15dd4 100644 --- a/Web/Scotty/Action.hs +++ b/Web/Scotty/Action.hs @@ -44,6 +44,9 @@ module Web.Scotty.Action , status , stream , text + , getResponseStatus + , getResponseHeaders + , getResponseContent , Param , Parsable(..) -- private to Scotty @@ -400,6 +403,20 @@ paramsWith f = ActionT (f <$> ask) getParams :: ActionEnv -> [Param] getParams e = envCaptureParams e <> envFormParams e <> envQueryParams e + +-- === access the fields of the Response being constructed + +-- | Access the HTTP 'Status' of the Response +getResponseStatus :: (MonadIO m) => ActionT m Status +getResponseStatus = srStatus <$> getResponseAction +-- | Access the HTTP headers of the Response +getResponseHeaders :: (MonadIO m) => ActionT m ResponseHeaders +getResponseHeaders = srHeaders <$> getResponseAction +-- | Access the content of the Response +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. diff --git a/Web/Scotty/Internal/Types.hs b/Web/Scotty/Internal/Types.hs index 3d2c7d22..98ec69aa 100644 --- a/Web/Scotty/Internal/Types.hs +++ b/Web/Scotty/Internal/Types.hs @@ -1,7 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DerivingStrategies #-} -{-# language DerivingVia #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} @@ -20,6 +19,7 @@ import qualified Control.Exception as E import Control.Monad (MonadPlus(..)) import Control.Monad.Base (MonadBase) import Control.Monad.Catch (MonadCatch, MonadThrow) +import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.IO.Class (MonadIO(..)) import UnliftIO (MonadUnliftIO(..)) import Control.Monad.Reader (MonadReader(..), ReaderT, asks) @@ -169,6 +169,11 @@ data ActionEnv = Env { envReq :: Request getResponse :: MonadIO m => ActionEnv -> m ScottyResponse getResponse ae = liftIO $ readTVarIO (envResponse ae) +getResponseAction :: (MonadIO m) => ActionT m ScottyResponse +getResponseAction = do + ae <- ask + getResponse ae + modifyResponse :: (MonadIO m) => (ScottyResponse -> ScottyResponse) -> ActionT m () modifyResponse f = do tv <- asks envResponse @@ -207,6 +212,15 @@ defaultScottyResponse = SR status200 [] (ContentBuilder mempty) 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) + +-- | 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'. +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. instance (MonadUnliftIO m) => Alternative (ActionT m) where empty = E.throw AENext a <|> b = do diff --git a/Web/Scotty/Trans.hs b/Web/Scotty/Trans.hs index d5d1f2ef..b42e28f5 100644 --- a/Web/Scotty/Trans.hs +++ b/Web/Scotty/Trans.hs @@ -35,13 +35,15 @@ module Web.Scotty.Trans -- | Note: only one of these should be present in any given route -- definition, as they completely replace the current 'Response' body. , text, html, file, json, stream, raw, nested + -- ** Accessing the fields of the Response + , getResponseHeaders, getResponseStatus, getResponseContent -- ** Exceptions , raise, raiseStatus, throw, rescue, next, finish, defaultHandler, liftAndCatchIO , StatusError(..) -- * Parsing Parameters , Param, Parsable(..), readEither -- * Types - , RoutePattern, File, Kilobytes, ErrorHandler, Handler(..) + , RoutePattern, File, Content(..), Kilobytes, ErrorHandler, Handler(..) -- * Monad Transformers , ScottyT, ActionT , ScottyState, defaultScottyState @@ -61,7 +63,7 @@ import Network.Wai.Handler.Warp (Port, runSettings, runSettingsSocket, setPort, 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 (ActionT(..), ScottyT(..), defaultScottyState, Application, RoutePattern, Options(..), defaultOptions, RouteOptions(..), defaultRouteOptions, ErrorHandler, Kilobytes, File, addMiddleware, setHandler, updateMaxRequestBodySize, routes, middlewares, ScottyException(..), ScottyState, defaultScottyState, StatusError(..), Content(..)) import Web.Scotty.Util (socketDescription) import Web.Scotty.Body (newBodyInfo) import Web.Scotty.Exceptions (Handler(..), catches) diff --git a/changelog.md b/changelog.md index 3d8e5655..163cc6c5 100644 --- a/changelog.md +++ b/changelog.md @@ -1,8 +1,16 @@ ## next [????.??.??] -* remove dependencies on 'base-compat' and 'base-compat-batteries' (#318) +* add getResponseHeaders, getResponseStatus, getResponseContent (#214) * add `captureParamMaybe`, `formParamMaybe`, `queryParamMaybe` (#322) +## 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). * Adds a new `nested` handler that allows you to place an entire WAI Application under a Scotty route (#233). @@ -15,8 +23,10 @@ Breaking: * (#310) Introduce `unliftio` as a dependency, and base exception handling on `catch`. -** Clarify the exception handling mechanism of ActionT, ScottyT. `rescue` changes signature to use proper `Exception` types rather than strings. -** All ActionT methods (`text`, `html` etc.) have now a MonadIO constraint on the base monad rather than Monad because the response is constructed in a TVar inside ActionEnv. `rescue` has a MonadUnliftIO constraint. The Alternative instance of ActionT also is based on MonadUnliftIO because `<|>` is implemented in terms of `catch`. `ScottyT` and `ActionT` do not have an exception type parameter anymore. +* (#310) Clarify the exception handling mechanism of ActionT, ScottyT. `rescue` changes signature to use proper `Exception` types rather than strings. Remove `ScottyError` typeclass. +* (#310) All ActionT methods (`text`, `html` etc.) have now a MonadIO constraint on the base monad rather than Monad because the response is constructed in a TVar inside ActionEnv. `rescue` has a MonadUnliftIO constraint. The Alternative instance of ActionT also is based on MonadUnliftIO because `<|>` is implemented in terms of `catch`. `ScottyT` and `ActionT` do not have an exception type parameter anymore. +* (#310) MonadError e (ActionT m) instance removed +* (#310) MonadFail (ActionT m) instance is missing by mistake. ## 0.12.1 [2022.11.17] * Fix CPP bug that prevented tests from building on Windows. diff --git a/scotty.cabal b/scotty.cabal index 07dfb7ba..e06ffb96 100644 --- a/scotty.cabal +++ b/scotty.cabal @@ -1,5 +1,5 @@ Name: scotty -Version: 0.20 +Version: 0.20.1 Synopsis: Haskell web framework inspired by Ruby's Sinatra, using WAI and Warp Homepage: https://github.com/scotty-web/scotty Bug-reports: https://github.com/scotty-web/scotty/issues @@ -69,7 +69,7 @@ Library Web.Scotty.Util default-language: Haskell2010 build-depends: aeson >= 0.6.2.1 && < 2.3, - base >= 4.6 && < 5, + base >= 4.14 && < 5, blaze-builder >= 0.3.3.0 && < 0.5, bytestring >= 0.10.0.2 && < 0.12, case-insensitive >= 1.0.0.1 && < 1.3, diff --git a/test/Web/ScottySpec.hs b/test/Web/ScottySpec.hs index 12d399ef..e9082198 100644 --- a/test/Web/ScottySpec.hs +++ b/test/Web/ScottySpec.hs @@ -141,6 +141,14 @@ spec = do get "/dictionary?word2=y" `shouldRespondWith` "y" get "/dictionary?word1=a&word2=b" `shouldRespondWith` "a" + context "MonadFail instance" $ do + withApp (Scotty.get "/" $ fail "boom!") $ do + it "returns 500 if not caught" $ + get "/" `shouldRespondWith` 500 + withApp (Scotty.get "/" $ (fail "boom!") `rescue` (\(_ :: StatusError) -> text "ok")) $ + it "can catch the StatusError thrown by fail" $ do + get "/" `shouldRespondWith` 200 { matchBody = "ok"} + describe "redirect" $ do withApp ( do