{-# LANGUAGE AllowAmbiguousTypes #-}

module IHP.LoginSupport.Helper.Controller
( currentUser
, currentUserOrNothing
, currentUserId
, ensureIsUser
, HasNewSessionUrl
, currentAdmin
, currentAdminOrNothing
, currentAdminId
, ensureIsAdmin
, login
, sessionKey
, logout
, CurrentUserRecord
, CurrentAdminRecord
, module IHP.AuthSupport.Authentication
, enableRowLevelSecurityIfLoggedIn
, currentRoleOrNothing
, currentRole
, currentRoleId
, ensureIsRole
) 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.Authentication
import IHP.Controller.Context
import qualified IHP.FrameworkConfig as FrameworkConfig
import qualified Database.PostgreSQL.Simple.ToField as PG
import Data.Kind
import Data.Typeable

currentRoleOrNothing :: forall user. (?context :: ControllerContext, HasNewSessionUrl user, Typeable user) => Maybe user
currentRoleOrNothing :: forall user.
(?context::ControllerContext, HasNewSessionUrl user,
 Typeable user) =>
Maybe user
currentRoleOrNothing = case IO (Maybe (Maybe user)) -> Maybe (Maybe user)
forall a. IO a -> a
unsafePerformIO (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
"initAuthentication @" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TypeRep -> Text
forall a. Show a => a -> Text
show (Proxy user -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @user)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" has not been called in initContext inside FrontController of this application")
{-# INLINE currentRoleOrNothing #-}

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

currentRoleId :: forall user userId. (?context :: ControllerContext, HasNewSessionUrl user, HasField "id" user userId, Typeable user) => userId
currentRoleId :: forall user userId.
(?context::ControllerContext, HasNewSessionUrl user,
 HasField "id" user userId, Typeable user) =>
userId
currentRoleId = (forall user.
(?context::ControllerContext, HasNewSessionUrl user,
 Typeable user) =>
user
currentRole @user).id
{-# INLINE currentRoleId #-}

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

currentUser :: forall user. (?context :: ControllerContext, HasNewSessionUrl user, Typeable user, user ~ CurrentUserRecord) => user
currentUser :: forall user.
(?context::ControllerContext, HasNewSessionUrl user, Typeable user,
 user ~ CurrentUserRecord) =>
user
currentUser = forall user.
(?context::ControllerContext, HasNewSessionUrl user,
 Typeable user) =>
user
currentRole @user
{-# INLINABLE currentUser #-}

currentUserOrNothing :: forall user. (?context :: ControllerContext, HasNewSessionUrl user, Typeable user, user ~ CurrentUserRecord) => (Maybe user)
currentUserOrNothing :: forall user.
(?context::ControllerContext, HasNewSessionUrl user, Typeable user,
 user ~ CurrentUserRecord) =>
Maybe user
currentUserOrNothing = forall user.
(?context::ControllerContext, HasNewSessionUrl user,
 Typeable user) =>
Maybe user
currentRoleOrNothing @user
{-# INLINABLE currentUserOrNothing #-}

currentUserId :: forall user userId. (?context :: ControllerContext, HasNewSessionUrl user, HasField "id" user userId, Typeable user, user ~ CurrentUserRecord) => userId
currentUserId :: forall user userId.
(?context::ControllerContext, HasNewSessionUrl user,
 HasField "id" user userId, Typeable user,
 user ~ CurrentUserRecord) =>
userId
currentUserId = forall user userId.
(?context::ControllerContext, HasNewSessionUrl user,
 HasField "id" user userId, Typeable user) =>
userId
currentRoleId @user
{-# INLINABLE currentUserId #-}

ensureIsUser :: forall user. (?context :: ControllerContext, HasNewSessionUrl user, Typeable user, user ~ CurrentUserRecord) => IO ()
ensureIsUser :: forall user.
(?context::ControllerContext, HasNewSessionUrl user, Typeable user,
 user ~ CurrentUserRecord) =>
IO ()
ensureIsUser = forall user.
(?context::ControllerContext, HasNewSessionUrl user,
 Typeable user) =>
IO ()
ensureIsRole @user
{-# INLINABLE ensureIsUser #-}

currentAdmin :: forall admin. (?context :: ControllerContext, HasNewSessionUrl admin, Typeable admin, admin ~ CurrentAdminRecord) => admin
currentAdmin :: forall admin.
(?context::ControllerContext, HasNewSessionUrl admin,
 Typeable admin, admin ~ CurrentAdminRecord) =>
admin
currentAdmin = forall user.
(?context::ControllerContext, HasNewSessionUrl user,
 Typeable user) =>
user
currentRole @admin
{-# INLINABLE currentAdmin #-}

currentAdminOrNothing :: forall admin. (?context :: ControllerContext, HasNewSessionUrl admin, Typeable admin, admin ~ CurrentAdminRecord) => (Maybe admin)
currentAdminOrNothing :: forall admin.
(?context::ControllerContext, HasNewSessionUrl admin,
 Typeable admin, admin ~ CurrentAdminRecord) =>
Maybe admin
currentAdminOrNothing = forall user.
(?context::ControllerContext, HasNewSessionUrl user,
 Typeable user) =>
Maybe user
currentRoleOrNothing @admin
{-# INLINABLE currentAdminOrNothing #-}

currentAdminId :: forall admin adminId. (?context :: ControllerContext, HasNewSessionUrl admin, HasField "id" admin adminId, Typeable admin, admin ~ CurrentAdminRecord) => adminId
currentAdminId :: forall admin adminId.
(?context::ControllerContext, HasNewSessionUrl admin,
 HasField "id" admin adminId, Typeable admin,
 admin ~ CurrentAdminRecord) =>
adminId
currentAdminId = forall user userId.
(?context::ControllerContext, HasNewSessionUrl user,
 HasField "id" user userId, Typeable user) =>
userId
currentRoleId @admin
{-# INLINABLE currentAdminId #-}

ensureIsAdmin :: forall (admin :: Type). (?context :: ControllerContext, HasNewSessionUrl admin, Typeable admin, admin ~ CurrentAdminRecord) => IO ()
ensureIsAdmin :: forall admin.
(?context::ControllerContext, HasNewSessionUrl admin,
 Typeable admin, admin ~ CurrentAdminRecord) =>
IO ()
ensureIsAdmin = forall user.
(?context::ControllerContext, HasNewSessionUrl user,
 Typeable user) =>
IO ()
ensureIsRole @admin
{-# INLINABLE ensureIsAdmin #-}

-- | 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 :: forall user id.
(?context::ControllerContext, KnownSymbol (GetModelName user),
 HasField "id" user id, Show id) =>
user -> IO ()
login user
user = ByteString -> Text -> IO ()
forall value.
(?context::ControllerContext, Serialize value) =>
ByteString -> value -> IO ()
Session.setSession (forall user. KnownSymbol (GetModelName user) => ByteString
sessionKey @user) (id -> Text
forall a. Show a => a -> Text
tshow (user
user.id))
{-# 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 :: forall user.
(?context::ControllerContext, KnownSymbol (GetModelName user)) =>
user -> IO ()
logout user
user = ByteString -> Text -> IO ()
forall value.
(?context::ControllerContext, Serialize value) =>
ByteString -> value -> IO ()
Session.setSession (forall user. KnownSymbol (GetModelName user) => ByteString
sessionKey @user) (Text
"" :: Text)
{-# INLINABLE logout #-}

sessionKey :: forall user. (KnownSymbol (ModelSupport.GetModelName user)) => ByteString
sessionKey :: forall user. KnownSymbol (GetModelName user) => 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 (forall model. KnownSymbol (GetModelName model) => Text
ModelSupport.getModelName @user)
{-# INLINABLE sessionKey #-}

redirectToLoginWithMessage :: (?context :: ControllerContext) => Text -> IO ()
redirectToLoginWithMessage :: (?context::ControllerContext) => 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 :: forall a. (?context::ControllerContext) => 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 :: forall userId.
(?context::ControllerContext, Typeable CurrentUserRecord,
 HasNewSessionUrl CurrentUserRecord,
 HasField "id" CurrentUserRecord userId, ToField userId) =>
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.frameworkConfig.rlsAuthenticatedRole
            let rlsUserId :: Action
rlsUserId = userId -> Action
forall a. ToField a => a -> Action
PG.toField CurrentUserRecord
user.id
            let rlsContext :: RowLevelSecurityContext
rlsContext = ModelSupport.RowLevelSecurityContext { Text
rlsAuthenticatedRole :: Text
$sel:rlsAuthenticatedRole:RowLevelSecurityContext :: Text
rlsAuthenticatedRole, Action
rlsUserId :: Action
$sel:rlsUserId:RowLevelSecurityContext :: Action
rlsUserId}
            RowLevelSecurityContext -> IO ()
forall value.
(?context::ControllerContext, Typeable value) =>
value -> IO ()
putContext RowLevelSecurityContext
rlsContext
        Maybe CurrentUserRecord
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()