{-|
Module: IHP.Controller.Redirect
Description: redirect helpers
Copyright: (c) digitally induced GmbH, 2020
-}
module IHP.Controller.Redirect (redirectTo, redirectToPath, redirectToUrl, forceRedirectToPath) 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 qualified Network.Wai as Wai
import qualified Data.Text.Encoding as TE
import Data.String.Conversions (cs)
import Data.Maybe (fromJust)
import Network.HTTP.Types (status200, status302)
import Network.HTTP.Types.Status
import Network.HTTP.Types.Header (hLocation)
import GHC.Records

import IHP.Controller.Context
import IHP.ControllerSupport

-- | Redirects to an action
-- 
-- __Example:__
-- 
-- > redirectTo ShowProjectAction { projectId = get #id project }
--
-- Use 'redirectToPath' if you want to redirect to a non-action url.
redirectTo :: (?context :: ControllerContext, HasPath action) => action -> IO ()
redirectTo :: action -> IO ()
redirectTo action
action = (?context::ControllerContext) => Text -> IO ()
Text -> IO ()
redirectToPath (action -> Text
forall controller. HasPath controller => controller -> Text
pathTo action
action)
{-# INLINABLE redirectTo #-}

-- TODO: redirectTo user

-- | Redirects to a path (given as a string)
--
-- __Example:__
-- 
-- > redirectToPath "/blog/wp-login.php"
--
-- Use 'redirectTo' if you want to redirect to a controller action.
redirectToPath :: (?context :: ControllerContext) => Text -> IO ()
redirectToPath :: Text -> IO ()
redirectToPath Text
path = (?context::ControllerContext) => Text -> IO ()
Text -> IO ()
redirectToUrl ((FrameworkConfig -> Text) -> Text
forall context a.
(?context::context, ConfigProvider context) =>
(FrameworkConfig -> a) -> a
fromConfig FrameworkConfig -> Text
baseUrl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
path)
{-# INLINABLE redirectToPath #-}

-- | like 'redirectToPath', but forcing full page reload
--
-- Forces reload by using a custom HTTP OK header mimicking a HTTP redirect
-- which is used as a signal to the AJAX call to perform page reload.
-- currently this is a workaround of last resort when you can't make your Javscript 
-- code behave properly together with morphdom and/or turbolinks
-- 
-- use 'forceRedirectToPath (pathTo action)' if you want to redirect to a controller action
forceRedirectToPath :: (?context :: ControllerContext) => Text -> IO ()
forceRedirectToPath :: Text -> IO ()
forceRedirectToPath Text
path = Response -> IO ()
respondAndExit (Response -> IO ()) -> Response -> IO ()
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> ByteString -> Response
Wai.responseLBS (Int -> ByteString -> Status
Status Int
280 ByteString
"IHP ForceRedirect") [(HeaderName
hLocation,  Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs ((FrameworkConfig -> Text) -> Text
forall context a.
(?context::context, ConfigProvider context) =>
(FrameworkConfig -> a) -> a
fromConfig FrameworkConfig -> Text
baseUrl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
path))] ByteString
""
{-# INLINABLE forceRedirectToPath #-}

-- | Redirects to a url (given as a string)
-- 
-- __Example:__
--
-- > redirectToUrl "https://example.com/hello-world.html"
--
-- Use 'redirectToPath' if you want to redirect to a relative path like @/hello-world.html@
redirectToUrl :: (?context :: ControllerContext) => Text -> IO ()
redirectToUrl :: Text -> IO ()
redirectToUrl Text
url = do
    let RequestContext { Respond
$sel:respond:RequestContext :: RequestContext -> Respond
respond :: Respond
respond } = ?context::ControllerContext
ControllerContext
?context ControllerContext
-> (ControllerContext -> RequestContext) -> RequestContext
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> Proxy "requestContext" -> ControllerContext -> RequestContext
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "requestContext" (Proxy "requestContext")
Proxy "requestContext"
#requestContext
    let !parsedUrl :: URI
parsedUrl = URI -> Maybe URI -> URI
forall a. a -> Maybe a -> a
fromMaybe 
            (Text -> URI
forall a. Text -> a
error (Text
"redirectToPath: Unable to parse url: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. Show a => a -> Text
show Text
url))
            (String -> Maybe URI
parseURI (Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs Text
url))
    let !redirectResponse :: Response
redirectResponse = Response -> Maybe Response -> Response
forall a. a -> Maybe a -> a
fromMaybe
            (Text -> Response
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)
    Response -> IO ()
respondAndExit Response
redirectResponse
{-# INLINABLE redirectToUrl #-}


-- | Redirects back to the last page
--
-- Uses the Referer header to do a redirect to page that got you here.
-- 
-- In case the Referer header is not set this function will redirect to @/@. Use 'redirectBackWithFallback' when you want
-- to specify a custom fallback url.
--
-- __Example:__
--
-- > action LikeAction { postId } = do
-- >     post <- fetch postId
-- >     post
-- >         |> incrementField #likesCount
-- >         |> updateRecord
-- >     
-- >     redirectBack
--
redirectBack :: (?context :: ControllerContext) => IO ()
redirectBack :: IO ()
redirectBack = (?context::ControllerContext) => Text -> IO ()
Text -> IO ()
redirectBackWithFallback Text
"/"
{-# INLINABLE redirectBack #-}

-- | Redirects back to the last page or the given fallback path in case the Referer header is missing
-- 
-- If you don't care about the missing-Referer-header case, use 'redirectBack'.
--
-- __Example:__
--
-- > action LikeAction { postId } = do
-- >     post <- fetch postId
-- >     post
-- >         |> incrementField #likesCount
-- >         |> updateRecord
-- >     
-- >     redirectBackWithFallback (pathTo ShowPostAction { postId = get #id post })
--
redirectBackWithFallback :: (?context :: ControllerContext) => Text -> IO ()
redirectBackWithFallback :: Text -> IO ()
redirectBackWithFallback Text
fallbackPath = do
    case (?context::ControllerContext) => ByteString -> Maybe ByteString
ByteString -> Maybe ByteString
getHeader ByteString
"Referer" of
        Just ByteString
referer -> (?context::ControllerContext) => Text -> IO ()
Text -> IO ()
redirectToPath (ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
referer)
        Maybe ByteString
Nothing -> (?context::ControllerContext) => Text -> IO ()
Text -> IO ()
redirectToPath Text
fallbackPath
{-# INLINABLE redirectBackWithFallback #-}