add redirectStatus function

Web/Scotty.hs

@@ -33,8 +33,10 @@
     , pathParams, captureParams, formParams, queryParams
       -- *** Files
     , files, filesOpts
-      -- ** Modifying the Response and Redirecting
-    , status, addHeader, setHeader, redirect
+      -- ** Modifying the Response
+    , status, addHeader, setHeader
+      -- ** Redirecting
+    , redirect, redirect300, redirect301, redirect302, redirect303, redirect304, redirect307, redirect308
       -- ** Setting Response Body
       --
       -- | Note: only one of these should be present in any given route
@@ -157,14 +159,14 @@
 --
 -- 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 '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 'catch'.
@@ -214,7 +216,7 @@
 --
 -- > 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.
@@ -222,8 +224,8 @@
 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.
+-- | Synonym for 'redirect302'.
+-- If you are unsure which redirect to use, you probably want this one.
 --
 -- > redirect "http://www.google.com"
 --
@@ -233,6 +235,48 @@
 redirect :: Text -> ActionM a
 redirect = Trans.redirect
 
+-- | Redirect to given URL with status 300 (Multiple Choices). Like throwing
+-- an uncatchable exception. Any code after the call to
+-- redirect will not be run.
+redirect300 :: Text -> ActionM a
+redirect300 = Trans.redirect300
+
+-- | Redirect to given URL with status 301 (Moved Permanently). Like throwing
+-- an uncatchable exception. Any code after the call to
+-- redirect will not be run.
+redirect301 :: Text -> ActionM a
+redirect301 = Trans.redirect301
+
+-- | Redirect to given URL with status 302 (Found). Like throwing
+-- an uncatchable exception. Any code after the call to
+-- redirect will not be run.
+redirect302 :: Text -> ActionM a
+redirect302 = Trans.redirect302
+
+-- | Redirect to given URL with status 303 (See Other). Like throwing
+-- an uncatchable exception. Any code after the call to
+-- redirect will not be run.
+redirect303 :: Text -> ActionM a
+redirect303 = Trans.redirect303
+
+-- | Redirect to given URL with status 304 (Not Modified). Like throwing
+-- an uncatchable exception. Any code after the call to
+-- redirect will not be run.
+redirect304 :: Text -> ActionM a
+redirect304 = Trans.redirect304
+
+-- | Redirect to given URL with status 307 (Temporary Redirect). Like throwing
+-- an uncatchable exception. Any code after the call to
+-- redirect will not be run.
+redirect307 :: Text -> ActionM a
+redirect307 = Trans.redirect307
+
+-- | Redirect to given URL with status 308 (Permanent Redirect). Like throwing
+-- an uncatchable exception. Any code after the call to
+-- redirect will not be run.
+redirect308 :: Text -> ActionM a
+redirect308 = Trans.redirect308
+
 -- | Get the 'Request' object.
 request :: ActionM Request
 request = Trans.request

Web/Scotty/Action.hs

@@ -46,6 +46,13 @@
     , nested
     , readEither
     , redirect
+    , redirect300
+    , redirect301
+    , redirect302
+    , redirect303
+    , redirect304
+    , redirect307
+    , redirect308
     , request
     , rescue
     , setHeader
@@ -82,7 +89,7 @@
 import           Data.Traversable (for)
 import qualified Data.HashMap.Strict        as HashMap
 import           Data.Int
 import           Data.List (foldl')
 import           Data.Maybe                 (maybeToList)
 import qualified Data.Text                  as T
 import           Data.Text.Encoding         as STE
@@ -106,7 +113,7 @@
 
 import           Web.FormUrlEncoded (Form(..), FromForm(..))
 import           Web.Scotty.Internal.Types
 import           Web.Scotty.Util (mkResponse, addIfNotPresent, add, replace, lazyTextToStrictByteString, decodeUtf8Lenient)
 import           UnliftIO.Exception (Handler(..), catch, catches, throwIO)
 import           System.IO (hPutStrLn, stderr)
 
@@ -136,7 +143,7 @@
 -- | Catches 'StatusError' and produces an appropriate HTTP response.
 statusErrorHandler :: MonadIO m => ErrorHandler m
 statusErrorHandler = Handler $ \case
   StatusError s e -> do
     status s
     let code = T.pack $ show $ statusCode s
     let msg = decodeUtf8Lenient $ statusMessage s
@@ -146,8 +153,8 @@
 -- All other cases of 'ActionError' are converted to HTTP responses.
 actionErrorHandler :: MonadIO m => ErrorHandler m
 actionErrorHandler = Handler $ \case
-  AERedirect url -> do
-    status status302
+  AERedirect s url -> do
+    status s
     setHeader "Location" url
   AENext -> next
   AEFinish -> return ()
@@ -227,7 +234,7 @@
 --
 -- 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 'catch'.
@@ -270,16 +277,61 @@
 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.
+-- | Synonym for 'redirect302'.
+-- If you are unsure which redirect to use, you probably want this one.
 --
 -- > redirect "http://www.google.com"
 --
 -- OR
 --
 -- > redirect "/foo/bar"
 redirect :: (Monad m) => T.Text -> ActionT m a
-redirect = E.throw . AERedirect
+redirect = redirect302
+
+-- | Redirect to given URL with status 300 (Multiple Choices). Like throwing
+-- an uncatchable exception. Any code after the call to
+-- redirect will not be run.
+redirect300 :: (Monad m) => T.Text -> ActionT m a
+redirect300 = redirectStatus status300
+
+-- | Redirect to given URL with status 301 (Moved Permanently). Like throwing
+-- an uncatchable exception. Any code after the call to
+-- redirect will not be run.
+redirect301 :: (Monad m) => T.Text -> ActionT m a
+redirect301 = redirectStatus status301
+
+-- | Redirect to given URL with status 302 (Found). Like throwing
+-- an uncatchable exception. Any code after the call to
+-- redirect will not be run.
+redirect302 :: (Monad m) => T.Text -> ActionT m a
+redirect302 = redirectStatus status302
+
+-- | Redirect to given URL with status 303 (See Other). Like throwing
+-- an uncatchable exception. Any code after the call to
+-- redirect will not be run.
+redirect303 :: (Monad m) => T.Text -> ActionT m a
+redirect303 = redirectStatus status303
+
+-- | Redirect to given URL with status 304 (Not Modified). Like throwing
+-- an uncatchable exception. Any code after the call to
+-- redirect will not be run.
+redirect304 :: (Monad m) => T.Text -> ActionT m a
+redirect304 = redirectStatus status304
+
+-- | Redirect to given URL with status 307 (Temporary Redirect). Like throwing
+-- an uncatchable exception. Any code after the call to
+-- redirect will not be run.
+redirect307 :: (Monad m) => T.Text -> ActionT m a
+redirect307 = redirectStatus status307
+
+-- | Redirect to given URL with status 308 (Permanent Redirect). Like throwing
+-- an uncatchable exception. Any code after the call to
+-- redirect will not be run.
+redirect308 :: (Monad m) => T.Text -> ActionT m a
+redirect308 = redirectStatus status308
+
+redirectStatus :: (Monad m) => Status -> T.Text -> ActionT m a
+redirectStatus s = E.throw . AERedirect s
 
 -- | Finish the execution of the current action. Like throwing an uncatchable
 -- exception. Any code after the call to finish will not be run.

Web/Scotty/Internal/Types.hs

@@ -22,7 +22,7 @@
 import           Control.Monad.IO.Class (MonadIO(..))
 import UnliftIO (MonadUnliftIO(..))
 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)
 import qualified Control.Monad.Trans.Resource as RT (InternalState, InvalidAccess)
@@ -122,7 +122,7 @@
 -- 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
-  = AERedirect T.Text -- ^ Redirect
+  = AERedirect Status T.Text -- ^ Redirect
   | AENext -- ^ Stop processing this route and skip to the next one
   | AEFinish -- ^ Stop processing the request
   deriving (Show, Typeable)

Web/Scotty/Trans.hs

@@ -39,8 +39,11 @@
     , pathParams, captureParams, formParams, queryParams
     -- *** Files
     , files, filesOpts
-      -- ** Modifying the Response and Redirecting
-    , status, Lazy.addHeader, Lazy.setHeader, Lazy.redirect
+      -- ** Modifying the Response
+    , status, Lazy.addHeader, Lazy.setHeader
+      -- ** Redirecting
+    , Lazy.redirect, Lazy.redirect300, Lazy.redirect301, Lazy.redirect302, Lazy.redirect303
+    , Lazy.redirect304, Lazy.redirect307, Lazy.redirect308
       -- ** Setting Response Body
       --
       -- | Note: only one of these should be present in any given route
@@ -133,7 +136,7 @@
            -> (m W.Response -> IO W.Response) -- ^ Run monad 'm' into 'IO', called at each action.
            -> ScottyT m ()
            -> n W.Application
 scottyAppT options runActionToIO defs = do
     let s = execState (runReaderT (runS defs) options) defaultScottyState
     let rapp req callback = do
           bodyInfo <- newBodyInfo req

Web/Scotty/Trans/Lazy.hs

@@ -16,26 +16,68 @@
 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.
+-- | Synonym for 'redirect302'.
+-- If you are unsure which redirect to use, you probably want this one.
 --
 -- > redirect "http://www.google.com"
 --
 -- OR
 --
 -- > redirect "/foo/bar"
 redirect :: (Monad m) => T.Text -> ActionT m a
-redirect = Base.redirect . T.toStrict
+redirect = redirect302
+
+-- | Redirect to given URL with status 300 (Multiple Choices). Like throwing
+-- an uncatchable exception. Any code after the call to
+-- redirect will not be run.
+redirect300 :: (Monad m) => T.Text -> ActionT m a
+redirect300 = Base.redirect300 . T.toStrict
+
+-- | Redirect to given URL with status 301 (Moved Permanently). Like throwing
+-- an uncatchable exception. Any code after the call to
+-- redirect will not be run.
+redirect301 :: (Monad m) => T.Text -> ActionT m a
+redirect301 = Base.redirect301 . T.toStrict
+
+-- | Redirect to given URL with status 302 (Found). Like throwing
+-- an uncatchable exception. Any code after the call to
+-- redirect will not be run.
+redirect302 :: (Monad m) => T.Text -> ActionT m a
+redirect302 = Base.redirect302 . T.toStrict
+
+-- | Redirect to given URL with status 303 (See Other). Like throwing
+-- an uncatchable exception. Any code after the call to
+-- redirect will not be run.
+redirect303 :: (Monad m) => T.Text -> ActionT m a
+redirect303 = Base.redirect303 . T.toStrict
+
+-- | Redirect to given URL with status 304 (Not Modified). Like throwing
+-- an uncatchable exception. Any code after the call to
+-- redirect will not be run.
+redirect304 :: (Monad m) => T.Text -> ActionT m a
+redirect304 = Base.redirect304 . T.toStrict
+
+-- | Redirect to given URL with status 307 (Temporary Redirect). Like throwing
+-- an uncatchable exception. Any code after the call to
+-- redirect will not be run.
+redirect307 :: (Monad m) => T.Text -> ActionT m a
+redirect307 = Base.redirect307 . T.toStrict
+
+-- | Redirect to given URL with status 308 (Permanent Redirect). Like throwing
+-- an uncatchable exception. Any code after the call to
+-- redirect will not be run.
+redirect308 :: (Monad m) => T.Text -> ActionT m a
+redirect308 = Base.redirect308 . T.toStrict
 
 -- | Get a request header. Header name is case-insensitive.
 header :: (Monad m) => T.Text -> ActionT m (Maybe T.Text)

Web/Scotty/Trans/Strict.hs

@@ -29,8 +29,11 @@ module Web.Scotty.Trans.Strict
     , captureParamMaybe, formParamMaybe, queryParamMaybe
     , captureParams, formParams, queryParams
     , jsonData, files
-      -- ** Modifying the Response and Redirecting
-    , status, Base.addHeader, Base.setHeader, Base.redirect
+      -- ** Modifying the Response 
+    , status, Base.addHeader, Base.setHeader
+      -- ** Redirecting
+    , Base.redirect, Base.redirect300, Base.redirect301, Base.redirect302, Base.redirect303
+    , Base.redirect304, Base.redirect307, Base.redirect308
       -- ** Setting Response Body
       --
       -- | Note: only one of these should be present in any given route

changelog.md

@@ -3,6 +3,7 @@
 * Fixed cookie example from `Cookie` module documentation. `getCookie` Function would return strict variant of `Text`. Will convert it into lazy variant using `fromStrict`. 
 * Exposed simple functions of `Cookie` module via `Web.Scotty` & `Web.Scotty.Trans`.
 * Add tests for URL encoding of query parameters and form parameters. Add `formData` action for decoding `FromForm` instances (#321).
+* Add explicit redirect functions for all redirect status codes.
 
 ### Breaking changes
 * Remove dependency on data-default class (#386). We have been exporting constants for default config values since 0.20, and this dependency was simply unnecessary.

test/Web/ScottySpec.hs

@@ -223,6 +223,64 @@ spec = do
         it "Responds with a 302 Redirect" $ do
           get "/a" `shouldRespondWith` 302 { matchHeaders = ["Location" <:> "/b"] }
 
+    describe "redirect300" $ do
+      withApp (
+        do
+          Scotty.get "/a" $ redirect300 "/b"
+              ) $ do
+        it "Responds with a 300 Redirect" $ do
+          get "/a" `shouldRespondWith` 300 { matchHeaders = ["Location" <:> "/b"] }
+
+
+    describe "redirect301" $ do
+      withApp (
+        do
+          Scotty.get "/a" $ redirect301 "/b"
+              ) $ do
+        it "Responds with a 301 Redirect" $ do
+          get "/a" `shouldRespondWith` 301 { matchHeaders = ["Location" <:> "/b"] }
+
+    describe "redirect302" $ do
+      withApp (
+        do
+          Scotty.get "/a" $ redirect302 "/b"
+              ) $ do
+        it "Responds with a 302 Redirect" $ do
+          get "/a" `shouldRespondWith` 302 { matchHeaders = ["Location" <:> "/b"] }
+
+
+    describe "redirect303" $ do
+      withApp (
+        do
+          Scotty.delete "/a" $ redirect303 "/b"
+              ) $ do
+        it "Responds with a 303 as passed in" $ do
+          delete "/a" `shouldRespondWith` 303 { matchHeaders = ["Location" <:> "/b"]}
+
+    describe "redirect304" $ do
+      withApp (
+        do
+          Scotty.get "/a" $ redirect304 "/b"
+              ) $ do
+        it "Responds with a 304 Redirect" $ do
+          get "/a" `shouldRespondWith` 304 { matchHeaders = ["Location" <:> "/b"] }
+
+    describe "redirect307" $ do
+      withApp (
+        do
+          Scotty.get "/a" $ redirect307 "/b"
+              ) $ do
+        it "Responds with a 307 Redirect" $ do
+          get "/a" `shouldRespondWith` 307 { matchHeaders = ["Location" <:> "/b"] }
+
+    describe "redirect308" $ do
+      withApp (
+        do
+          Scotty.get "/a" $ redirect308 "/b"
+              ) $ do
+        it "Responds with a 308 Redirect" $ do
+          get "/a" `shouldRespondWith` 308 { matchHeaders = ["Location" <:> "/b"] }
+
     describe "Parsable" $ do
       it "parses a UTCTime string" $ do
         parseParam "2023-12-18T00:38:00Z" `shouldBe` Right (UTCTime (fromGregorian 2023 12 18) (secondsToDiffTime (60 * 38)) )