Merge branch 'master' of github.com:digitallyinduced/ihp

Author: mpscholten

Guide/controller.markdown

@@ -350,6 +350,13 @@ When you need to pass a custom query parameter, you cannot use the [`redirectTo`
 
 The redirect will use HTTP status code `302`. The [`baseUrl`](https://ihp.digitallyinduced.com/api-docs/IHP-FrameworkConfig.html#t:FrameworkConfig) in `Config/Config.hs` will be used. In development mode, the [`baseUrl`](https://ihp.digitallyinduced.com/api-docs/IHP-FrameworkConfig.html#t:FrameworkConfig) might not be specified in `Config/Config.hs`. Then it will be set to localhost by default.
 
+If you need to force the follow-up request to be a `GET` (e.g. after a `POST` or `DELETE`), use [`redirectToSeeOther`](https://ihp.digitallyinduced.com/api-docs/IHP-Controller-Redirect.html#v:redirectToSeeOther) to send a 303 See Other:
+
+```haskell
+action ExampleAction = do
+    redirectToSeeOther ShowPostAction { postId = ... }
+```
+
 ### Redirect to a Path
 
 Use [`redirectToPath`](https://ihp.digitallyinduced.com/api-docs/IHP-Controller-Redirect.html#v:redirectToPath) when you want to redirect to a path on the same domain:
@@ -366,6 +373,13 @@ action ExampleAction = do
     redirectToPath ((pathTo ShowPostAction { .. }) <> "&details=on")
 ```
 
+Use [`redirectToPathSeeOther`](https://ihp.digitallyinduced.com/api-docs/IHP-Controller-Redirect.html#v:redirectToPathSeeOther) to send a 303 redirect to a path:
+
+```haskell
+action ExampleAction = do
+    redirectToPathSeeOther "/blog/wp-login.php"
+```
+
 ### Redirect to a URL
 
 Use [`redirectToUrl`](https://ihp.digitallyinduced.com/api-docs/IHP-Controller-Redirect.html#v:redirectToUrl) to redirect to some external URL:
@@ -375,6 +389,13 @@ action ExampleAction = do
     redirectToUrl "https://example.com/hello-world.html"
 ```
 
+Use [`redirectToUrlSeeOther`](https://ihp.digitallyinduced.com/api-docs/IHP-Controller-Redirect.html#v:redirectToUrlSeeOther) to send a 303 redirect to some external URL:
+
+```haskell
+action ExampleAction = do
+    redirectToUrlSeeOther "https://example.com/hello-world.html"
+```
+
 ## Action Execution
 
 When calling a function to send the response, IHP will stop executing the action. Internally this is implemented by throwing and catching a [`ResponseException`](https://ihp.digitallyinduced.com/api-docs/src/IHP.ControllerSupport.html#ResponseException). Any code after e.g. a `render SomeView { .. }` call will not be called. This also applies to all redirect helpers.

ihp/IHP/AuthSupport/Controller/Sessions.hs

@@ -37,7 +37,7 @@ newSessionAction :: forall record action.
     ) => IO ()
 newSessionAction = do
     let alreadyLoggedIn = isJust (currentUserOrNothing @record)
-    when alreadyLoggedIn (redirectToPath (afterLoginRedirectPath @record))
+    when alreadyLoggedIn (redirectToPathSeeOther (afterLoginRedirectPath @record))
 
     let user = newRecord @record
     render NewView { .. }
@@ -85,7 +85,7 @@ createSessionAction = do
                             |> set #failedLoginAttempts 0
                             |> updateRecord
                     redirectUrl <- getSessionAndClear "IHP.LoginSupport.redirectAfterLogin"
-                    redirectToPath (fromMaybe (afterLoginRedirectPath @record) redirectUrl)
+                    redirectToPathSeeOther (fromMaybe (afterLoginRedirectPath @record) redirectUrl)
                 else do
                     setErrorMessage "Invalid Credentials"
                     user :: record <- user
@@ -117,7 +117,7 @@ deleteSessionAction = do
             beforeLogout user
             logout user
         Nothing -> pure ()
-    redirectToPath (afterLogoutRedirectPath @record)
+    redirectToPathSeeOther (afterLogoutRedirectPath @record)
 {-# INLINE deleteSessionAction #-}
 
 currentUserOrNothing :: forall user. (?context :: ControllerContext, HasNewSessionUrl user, Typeable user) => (Maybe user)

ihp/IHP/Controller/Redirect.hs

@@ -7,6 +7,9 @@ module IHP.Controller.Redirect
 ( redirectTo
 , redirectToPath
 , redirectToUrl
+, redirectToSeeOther
+, redirectToPathSeeOther
+, redirectToUrlSeeOther
 , redirectBack
 , redirectBackWithFallback
 ) where
@@ -33,6 +36,13 @@ redirectTo :: (?context :: ControllerContext, HasPath action) => action -> IO ()
 redirectTo action = redirectToPath (pathTo action)
 {-# INLINABLE redirectTo #-}
 
+-- | Redirects to an action using HTTP 303 See Other
+--
+-- Forces the follow-up request to be a GET (useful after POST/DELETE).
+redirectToSeeOther :: (?context :: ControllerContext, HasPath action) => action -> IO ()
+redirectToSeeOther action = redirectToPathSeeOther (pathTo action)
+{-# INLINABLE redirectToSeeOther #-}
+
 -- TODO: redirectTo user
 
 -- | Redirects to a path (given as a string)
@@ -48,6 +58,15 @@ redirectToPath path = redirectToUrl (convertString baseUrl <> path)
         baseUrl = Approot.getApproot ?context.requestContext.request
 {-# INLINABLE redirectToPath #-}
 
+-- | Redirects to a path using HTTP 303 See Other
+--
+-- Forces the follow-up request to be a GET (useful after POST/DELETE).
+redirectToPathSeeOther :: (?context :: ControllerContext) => Text -> IO ()
+redirectToPathSeeOther path = redirectToUrlSeeOther (convertString baseUrl <> path)
+    where
+        baseUrl = Approot.getApproot ?context.requestContext.request
+{-# INLINABLE redirectToPathSeeOther #-}
+
 -- | Redirects to a url (given as a string)
 --
 -- __Example:__
@@ -67,6 +86,20 @@ redirectToUrl url = do
     respondAndExit redirectResponse
 {-# INLINABLE redirectToUrl #-}
 
+-- | Redirects to a url using HTTP 303 See Other
+--
+-- Forces the follow-up request to be a GET (useful after POST/DELETE).
+redirectToUrlSeeOther :: (?context :: ControllerContext) => Text -> IO ()
+redirectToUrlSeeOther url = do
+    let RequestContext { respond } = ?context.requestContext
+    let !parsedUrl = fromMaybe
+            (error ("redirectToUrlSeeOther: Unable to parse url: " <> show url))
+            (parseURI (cs url))
+    let !redirectResponse = fromMaybe
+            (error "redirectToUrlSeeOther: Unable to construct redirect response")
+            (Network.Wai.Util.redirect status303 [] parsedUrl)
+    respondAndExit redirectResponse
+{-# INLINABLE redirectToUrlSeeOther #-}
 
 -- | Redirects back to the last page
 --