add redirects per status code (scotty-web#402)

Web/Scotty.hs

@@ -33,8 +33,10 @@ module Web.Scotty
     , 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
@@ -222,8 +224,8 @@ 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.
+-- | 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 @@ liftAndCatchIO = Trans.liftAndCatchIO
 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 @@ module Web.Scotty.Action
     , nested
     , readEither
     , redirect
+    , redirect300
+    , redirect301
+    , redirect302
+    , redirect303
+    , redirect304
+    , redirect307
+    , redirect308
     , request
     , rescue
     , setHeader
@@ -146,8 +153,8 @@ statusErrorHandler = Handler $ \case
 -- 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 ()
@@ -270,16 +277,61 @@ liftAndCatchIO :: MonadIO m => IO a -> ActionT m a
 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

@@ -122,7 +122,7 @@ newtype ScottyT m a =
 -- 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 @@ module Web.Scotty.Trans
     , 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

Web/Scotty/Trans/Lazy.hs

@@ -26,16 +26,58 @@ 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)) )