module IHP.Controller.Redirect
( redirectTo
, redirectToPath
, redirectToUrl
, redirectBack
, redirectBackWithFallback
) where
import IHP.Prelude
import qualified Network.Wai.Util
import Network.URI (parseURI)
import IHP.Controller.RequestContext
import IHP.RouterSupport (HasPath (pathTo))
import IHP.FrameworkConfig
import Network.HTTP.Types.Status
import IHP.Controller.Context
import IHP.ControllerSupport
redirectTo :: (?context :: ControllerContext, HasPath action) => action -> IO ()
redirectTo :: forall action.
(?context::ControllerContext, HasPath action) =>
action -> IO ()
redirectTo action
action = (?context::ControllerContext) => Text -> IO ()
redirectToPath (forall controller. HasPath controller => controller -> Text
pathTo action
action)
{-# INLINABLE redirectTo #-}
redirectToPath :: (?context :: ControllerContext) => Text -> IO ()
redirectToPath :: (?context::ControllerContext) => Text -> IO ()
redirectToPath Text
path = (?context::ControllerContext) => Text -> IO ()
redirectToUrl (?context::ControllerContext
?context.frameworkConfig.baseUrl forall a. Semigroup a => a -> a -> a
<> Text
path)
{-# INLINABLE redirectToPath #-}
redirectToUrl :: (?context :: ControllerContext) => Text -> IO ()
redirectToUrl :: (?context::ControllerContext) => Text -> IO ()
redirectToUrl Text
url = do
let RequestContext { Respond
$sel:respond:RequestContext :: RequestContext -> Respond
respond :: Respond
respond } = ?context::ControllerContext
?context forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get forall a. IsLabel "requestContext" a => a
#requestContext
let !parsedUrl :: URI
parsedUrl = forall a. a -> Maybe a -> a
fromMaybe
(forall a. Text -> a
error (Text
"redirectToPath: Unable to parse url: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
show Text
url))
(String -> Maybe URI
parseURI (forall a b. ConvertibleStrings a b => a -> b
cs Text
url))
let !redirectResponse :: Response
redirectResponse = forall a. a -> Maybe a -> a
fromMaybe
(forall a. Text -> a
error Text
"redirectToPath: Unable to construct redirect response")
(Status -> ResponseHeaders -> URI -> Maybe Response
Network.Wai.Util.redirect Status
status302 [] URI
parsedUrl)
(?context::ControllerContext) => Response -> IO ()
respondAndExit Response
redirectResponse
{-# INLINABLE redirectToUrl #-}
redirectBack :: (?context :: ControllerContext) => IO ()
redirectBack :: (?context::ControllerContext) => IO ()
redirectBack = (?context::ControllerContext) => Text -> IO ()
redirectBackWithFallback Text
"/"
{-# INLINABLE redirectBack #-}
redirectBackWithFallback :: (?context :: ControllerContext) => Text -> IO ()
redirectBackWithFallback :: (?context::ControllerContext) => Text -> IO ()
redirectBackWithFallback Text
fallbackPathOrUrl = do
case (?context::ControllerContext) => ByteString -> Maybe ByteString
getHeader ByteString
"Referer" of
Just ByteString
referer -> case String -> Maybe URI
parseURI (forall a b. ConvertibleStrings a b => a -> b
cs ByteString
referer) of
Just URI
uri -> (?context::ControllerContext) => Text -> IO ()
redirectToUrl (forall a. Show a => a -> Text
tshow URI
uri)
Maybe URI
Nothing -> (?context::ControllerContext) => Text -> IO ()
redirectToPath (forall a b. ConvertibleStrings a b => a -> b
cs ByteString
referer)
Maybe ByteString
Nothing -> case String -> Maybe URI
parseURI (forall a b. ConvertibleStrings a b => a -> b
cs Text
fallbackPathOrUrl) of
Just URI
uri -> (?context::ControllerContext) => Text -> IO ()
redirectToUrl (forall a. Show a => a -> Text
tshow URI
uri)
Maybe URI
Nothing -> (?context::ControllerContext) => Text -> IO ()
redirectToPath Text
fallbackPathOrUrl
{-# INLINABLE redirectBackWithFallback #-}