{-# LANGUAGE AllowAmbiguousTypes #-}

module IHP.LoginSupport.Helper.Controller
( currentUser
, currentUserOrNothing
, currentUserId
, ensureIsUser
, HasNewSessionUrl
, currentAdmin
, currentAdminOrNothing
, currentAdminId
, ensureIsAdmin
, login
, sessionKey
, logout
, CurrentUserRecord
, CurrentAdminRecord
, module IHP.AuthSupport.Authorization
, module IHP.AuthSupport.Authentication
, enableRowLevelSecurityIfLoggedIn
) where

import IHP.Prelude
import IHP.Controller.Redirect
import IHP.Controller.Session
import IHP.LoginSupport.Types
import qualified IHP.Controller.Session as Session
import IHP.FlashMessages.ControllerFunctions
import qualified IHP.ModelSupport as ModelSupport
import IHP.ControllerSupport
import System.IO.Unsafe (unsafePerformIO)
import IHP.AuthSupport.Authorization
import IHP.AuthSupport.Authentication
import IHP.Controller.Context
import qualified IHP.FrameworkConfig as FrameworkConfig
import qualified Database.PostgreSQL.Simple.ToField as PG

{-# INLINABLE currentUser #-}
currentUser :: forall user. (?context :: ControllerContext, HasNewSessionUrl user, Typeable user, user ~ CurrentUserRecord) => user
currentUser :: user
currentUser = user -> Maybe user -> user
forall a. a -> Maybe a -> a
fromMaybe (Text -> user
forall a. (?context::ControllerContext) => Text -> a
redirectToLogin (Proxy user -> Text
forall user. HasNewSessionUrl user => Proxy user -> Text
newSessionUrl (Proxy user
forall k (t :: k). Proxy t
Proxy @user))) Maybe user
forall user.
(?context::ControllerContext, HasNewSessionUrl user, Typeable user,
 user ~ CurrentUserRecord) =>
Maybe user
currentUserOrNothing

{-# INLINABLE currentUserOrNothing #-}
currentUserOrNothing :: forall user. (?context :: ControllerContext, HasNewSessionUrl user, Typeable user, user ~ CurrentUserRecord) => (Maybe user)
currentUserOrNothing :: Maybe user
currentUserOrNothing = case IO (Maybe (Maybe user)) -> Maybe (Maybe user)
forall a. IO a -> a
unsafePerformIO ((?context::ControllerContext, Typeable (Maybe user)) =>
IO (Maybe (Maybe user))
forall value.
(?context::ControllerContext, Typeable value) =>
IO (Maybe value)
maybeFromContext @(Maybe user)) of
    Just Maybe user
user -> Maybe user
user
    Maybe (Maybe user)
Nothing -> Text -> Maybe user
forall a. Text -> a
error Text
"currentUserOrNothing: initAuthentication @User has not been called in initContext inside FrontController of this application"

{-# INLINABLE currentUserId #-}
currentUserId :: forall user userId. (?context :: ControllerContext, HasNewSessionUrl user, HasField "id" user userId, Typeable user, user ~ CurrentUserRecord) => userId
currentUserId :: userId
currentUserId = (?context::ControllerContext, HasNewSessionUrl user, Typeable user,
 user ~ CurrentUserRecord) =>
user
forall user.
(?context::ControllerContext, HasNewSessionUrl user, Typeable user,
 user ~ CurrentUserRecord) =>
user
currentUser @user user -> (user -> userId) -> userId
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> Proxy "id" -> user -> userId
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "id" (Proxy "id")
Proxy "id"
#id

{-# INLINABLE ensureIsUser #-}
ensureIsUser :: forall user userId. (?context :: ControllerContext, HasNewSessionUrl user, HasField "id" user userId, Typeable user, user ~ CurrentUserRecord) => IO ()
ensureIsUser :: IO ()
ensureIsUser =
    case (?context::ControllerContext, HasNewSessionUrl user, Typeable user,
 user ~ CurrentUserRecord) =>
Maybe user
forall user.
(?context::ControllerContext, HasNewSessionUrl user, Typeable user,
 user ~ CurrentUserRecord) =>
Maybe user
currentUserOrNothing @user of
        Just user
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Maybe user
Nothing -> (?context::ControllerContext) => Text -> IO ()
Text -> IO ()
redirectToLoginWithMessage (Proxy user -> Text
forall user. HasNewSessionUrl user => Proxy user -> Text
newSessionUrl (Proxy user
forall k (t :: k). Proxy t
Proxy :: Proxy user))

{-# INLINABLE currentAdmin #-}
currentAdmin :: forall admin. (?context :: ControllerContext, HasNewSessionUrl admin, Typeable admin) => admin
currentAdmin :: admin
currentAdmin = admin -> Maybe admin -> admin
forall a. a -> Maybe a -> a
fromMaybe (Text -> admin
forall a. (?context::ControllerContext) => Text -> a
redirectToLogin (Proxy admin -> Text
forall user. HasNewSessionUrl user => Proxy user -> Text
newSessionUrl (Proxy admin
forall k (t :: k). Proxy t
Proxy @admin))) Maybe admin
forall admin.
(?context::ControllerContext, HasNewSessionUrl admin,
 Typeable admin) =>
Maybe admin
currentAdminOrNothing

{-# INLINABLE currentAdminOrNothing #-}
currentAdminOrNothing :: forall admin. (?context :: ControllerContext, HasNewSessionUrl admin, Typeable admin) => (Maybe admin)
currentAdminOrNothing :: Maybe admin
currentAdminOrNothing = case IO (Maybe (Maybe admin)) -> Maybe (Maybe admin)
forall a. IO a -> a
unsafePerformIO ((?context::ControllerContext, Typeable (Maybe admin)) =>
IO (Maybe (Maybe admin))
forall value.
(?context::ControllerContext, Typeable value) =>
IO (Maybe value)
maybeFromContext @(Maybe admin)) of
    Just Maybe admin
admin -> Maybe admin
admin
    Maybe (Maybe admin)
Nothing -> Text -> Maybe admin
forall a. Text -> a
error Text
"currentAdminOrNothing: initAuthentication @Admin has not been called in initContext inside FrontController of this application"

{-# INLINABLE currentAdminId #-}
currentAdminId :: forall admin adminId. (?context :: ControllerContext, HasNewSessionUrl admin, HasField "id" admin adminId, Typeable admin) => adminId
currentAdminId :: adminId
currentAdminId = (?context::ControllerContext, HasNewSessionUrl admin,
 Typeable admin) =>
admin
forall admin.
(?context::ControllerContext, HasNewSessionUrl admin,
 Typeable admin) =>
admin
currentAdmin @admin admin -> (admin -> adminId) -> adminId
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> Proxy "id" -> admin -> adminId
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "id" (Proxy "id")
Proxy "id"
#id

{-# INLINABLE ensureIsAdmin #-}
ensureIsAdmin :: forall admin adminId. (?context :: ControllerContext, HasNewSessionUrl admin, Typeable admin) => IO ()
ensureIsAdmin :: IO ()
ensureIsAdmin =
    case (?context::ControllerContext, HasNewSessionUrl admin,
 Typeable admin) =>
Maybe admin
forall admin.
(?context::ControllerContext, HasNewSessionUrl admin,
 Typeable admin) =>
Maybe admin
currentAdminOrNothing @admin of
        Just admin
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Maybe admin
Nothing -> (?context::ControllerContext) => Text -> IO ()
Text -> IO ()
redirectToLoginWithMessage (Proxy admin -> Text
forall user. HasNewSessionUrl user => Proxy user -> Text
newSessionUrl (Proxy admin
forall k (t :: k). Proxy t
Proxy :: Proxy admin))

-- | Log's in a user
--
-- Examples:
-- 
-- > action ExampleAction = do
-- >     user <- query @User |> fetchOne
-- >     login user
-- >     
-- >     redirectToPath "/"
--
login :: forall user id. (?context :: ControllerContext, KnownSymbol (ModelSupport.GetModelName user), HasField "id" user id, Show id) => user -> IO ()
login :: user -> IO ()
login user
user = ByteString -> Text -> IO ()
forall value.
(?context::ControllerContext, Serialize value) =>
ByteString -> value -> IO ()
Session.setSession (KnownSymbol (GetModelName user) => ByteString
forall user. KnownSymbol (GetModelName user) => ByteString
sessionKey @user) (id -> Text
forall a. Show a => a -> Text
tshow (Proxy "id" -> user -> id
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "id" (Proxy "id")
Proxy "id"
#id user
user))
{-# INLINABLE login #-}

-- | Log's out a user
--
-- Example:
--
-- > action LogoutAction = do
-- >     let user = currentUser
-- >     logout user
-- >     
-- >     redirectToPath "/"
--
logout :: forall user. (?context :: ControllerContext, KnownSymbol (ModelSupport.GetModelName user)) => user -> IO ()
logout :: user -> IO ()
logout user
user = ByteString -> Text -> IO ()
forall value.
(?context::ControllerContext, Serialize value) =>
ByteString -> value -> IO ()
Session.setSession (KnownSymbol (GetModelName user) => ByteString
forall user. KnownSymbol (GetModelName user) => ByteString
sessionKey @user) (Text
"" :: Text)
{-# INLINABLE logout #-}

{-# INLINABLE sessionKey #-}
sessionKey :: forall user. (KnownSymbol (ModelSupport.GetModelName user)) => ByteString
sessionKey :: ByteString
sessionKey = ByteString
"login." ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (KnownSymbol (GetModelName user) => Text
forall model. KnownSymbol (GetModelName model) => Text
ModelSupport.getModelName @user)

redirectToLoginWithMessage :: (?context :: ControllerContext) => Text -> IO ()
redirectToLoginWithMessage :: Text -> IO ()
redirectToLoginWithMessage Text
newSessionPath = do
    (?context::ControllerContext) => Text -> IO ()
Text -> IO ()
setSuccessMessage Text
"Please log in to access this page"
    ByteString -> ByteString -> IO ()
forall value.
(?context::ControllerContext, Serialize value) =>
ByteString -> value -> IO ()
setSession ByteString
"IHP.LoginSupport.redirectAfterLogin" ByteString
(?context::ControllerContext) => ByteString
getRequestPathAndQuery
    (?context::ControllerContext) => Text -> IO ()
Text -> IO ()
redirectToPath Text
newSessionPath
    Text -> IO ()
forall a. Text -> a
error Text
"Unreachable"


redirectToLogin :: (?context :: ControllerContext) => Text -> a
redirectToLogin :: Text -> a
redirectToLogin Text
newSessionPath = IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ do
    (?context::ControllerContext) => Text -> IO ()
Text -> IO ()
redirectToPath Text
newSessionPath
    Text -> IO a
forall a. Text -> a
error Text
"Unreachable"

-- | After this call the security policies defined in your Schema.sql will be applied to the controller actions called after this
--
-- __Example:__
--
-- > instance InitControllerContext WebApplication where
-- >     initContext = do
-- >         initAuthentication @User
-- >         enableRowLevelSecurityIfLoggedIn
--
-- Let's assume we have a policy defined in our Schema.sql that only allows users to see and edit rows in the projects table that have @projects.user_id = current_user_id@:
--
-- > CREATE POLICY "Users can manage their projects" ON projects USING (user_id = ihp_user_id()) WITH CHECK (user_id = ihp_user_id());
--
-- Now any database queries to our @projects@ table will have this policy applied.
--
-- E.g. this action will now only show the users projects, even though no explicit @filterWhere (#userId, currentUserId)@ is specified on the query:
--
-- > action ProjectsAction = do
-- >     projects <- query @Project |> fetch
--
enableRowLevelSecurityIfLoggedIn ::
    ( ?context :: ControllerContext
    , Typeable CurrentUserRecord
    , HasNewSessionUrl CurrentUserRecord
    , HasField "id" CurrentUserRecord userId
    , PG.ToField userId
    ) => IO ()
enableRowLevelSecurityIfLoggedIn :: IO ()
enableRowLevelSecurityIfLoggedIn = do
    case Maybe CurrentUserRecord
forall user.
(?context::ControllerContext, HasNewSessionUrl user, Typeable user,
 user ~ CurrentUserRecord) =>
Maybe user
currentUserOrNothing of
        Just CurrentUserRecord
user -> do
            let rlsAuthenticatedRole :: Text
rlsAuthenticatedRole = ?context::ControllerContext
ControllerContext
?context
                    ControllerContext
-> (ControllerContext -> FrameworkConfig) -> FrameworkConfig
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> ControllerContext -> FrameworkConfig
forall a. ConfigProvider a => a -> FrameworkConfig
FrameworkConfig.getFrameworkConfig
                    FrameworkConfig -> (FrameworkConfig -> Text) -> Text
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> Proxy "rlsAuthenticatedRole" -> FrameworkConfig -> Text
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "rlsAuthenticatedRole" (Proxy "rlsAuthenticatedRole")
Proxy "rlsAuthenticatedRole"
#rlsAuthenticatedRole
            let rlsUserId :: Action
rlsUserId = userId -> Action
forall a. ToField a => a -> Action
PG.toField (Proxy "id" -> CurrentUserRecord -> userId
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "id" (Proxy "id")
Proxy "id"
#id CurrentUserRecord
user)
            let rlsContext :: RowLevelSecurityContext
rlsContext = RowLevelSecurityContext :: Text -> Action -> RowLevelSecurityContext
ModelSupport.RowLevelSecurityContext { Text
$sel:rlsAuthenticatedRole:RowLevelSecurityContext :: Text
rlsAuthenticatedRole :: Text
rlsAuthenticatedRole, Action
$sel:rlsUserId:RowLevelSecurityContext :: Action
rlsUserId :: Action
rlsUserId}
            RowLevelSecurityContext -> IO ()
forall value.
(?context::ControllerContext, Typeable value) =>
value -> IO ()
putContext RowLevelSecurityContext
rlsContext
        Maybe CurrentUserRecord
Nothing -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()