{-|
Module: IHP.DataSync.Role
Description: Postgres role management for RLS
Copyright: (c) digitally induced GmbH, 2021

The default user that creates a table in postgres always
has access to all rows inside the table. The default user is not restricted
to the RLS policies.

Therefore we need to use a second role whenever we want to
make a query with RLS enabled. Basically for every query we do, we'll
wrap it in a transaction and then use 'SET LOCAL ROLE ..' to switch to
our second role for the duration of the transaction.

-}
module IHP.DataSync.Role where

import IHP.Prelude
import Data.Aeson
import IHP.QueryBuilder
import IHP.DataSync.DynamicQuery
import IHP.FrameworkConfig
import IHP.ModelSupport
import qualified Database.PostgreSQL.Simple as PG
import qualified Database.PostgreSQL.Simple.Types as PG

doesRoleExists :: (?modelContext :: ModelContext) => Text -> IO Bool
doesRoleExists :: Text -> IO Bool
doesRoleExists Text
name = Query -> [Text] -> IO Bool
forall q value.
(?modelContext::ModelContext, ToRow q, Show q, FromField value) =>
Query -> q -> IO value
sqlQueryScalar Query
"SELECT EXISTS(SELECT 1 FROM pg_roles WHERE rolname = ? LIMIT 1)" [Text
name]

ensureAuthenticatedRoleExists :: (?context :: context, ConfigProvider context, ?modelContext :: ModelContext) => IO ()
ensureAuthenticatedRoleExists :: IO ()
ensureAuthenticatedRoleExists = do
    Bool
roleExists <- (?modelContext::ModelContext) => Text -> IO Bool
Text -> IO Bool
doesRoleExists Text
forall context. (?context::context, ConfigProvider context) => Text
authenticatedRole
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
roleExists ((?modelContext::ModelContext) => Text -> IO ()
Text -> IO ()
createAuthenticatedRole Text
forall context. (?context::context, ConfigProvider context) => Text
authenticatedRole)
    (?modelContext::ModelContext) => Text -> IO ()
Text -> IO ()
grantPermissions Text
forall context. (?context::context, ConfigProvider context) => Text
authenticatedRole

createAuthenticatedRole :: (?modelContext :: ModelContext) => Text -> IO ()
createAuthenticatedRole :: Text -> IO ()
createAuthenticatedRole Text
role = do
    -- The role is only going to be used from 'SET ROLE ..' calls
    -- Therefore we can disallow direct connection with NOLOGIN
    Query -> [Identifier] -> IO Int64
forall q.
(?modelContext::ModelContext, ToRow q, Show q) =>
Query -> q -> IO Int64
sqlExec Query
"CREATE ROLE ? NOLOGIN" [Text -> Identifier
PG.Identifier Text
role]


    () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

grantPermissions :: (?modelContext :: ModelContext) => Text -> IO ()
grantPermissions :: Text -> IO ()
grantPermissions Text
role = do
    -- From SO https://stackoverflow.com/a/17355059/14144232
    --
    -- GRANTs on different objects are separate. GRANTing on a database doesn't GRANT rights to the schema within. Similiarly, GRANTing on a schema doesn't grant rights on the tables within.
    -- 
    -- If you have rights to SELECT from a table, but not the right to see it in the schema that contains it then you can't access the table.
    -- 
    -- The rights tests are done in order:
    -- 
    -- Do you have `USAGE` on the schema? 
    --     No:  Reject access. 
    --     Yes: Do you also have the appropriate rights on the table? 
    --         No:  Reject access. 
    --         Yes: Check column privileges.

    -- The role should have access to all existing tables in our schema
    Query -> [Identifier] -> IO Int64
forall q.
(?modelContext::ModelContext, ToRow q, Show q) =>
Query -> q -> IO Int64
sqlExec Query
"GRANT USAGE ON SCHEMA public TO ?" [Text -> Identifier
PG.Identifier Text
role]
    
    -- The role should have access to all existing tables in our schema
    Query -> [Identifier] -> IO Int64
forall q.
(?modelContext::ModelContext, ToRow q, Show q) =>
Query -> q -> IO Int64
sqlExec Query
"GRANT ALL PRIVILEGES ON ALL TABLES IN SCHEMA public TO ?" [Text -> Identifier
PG.Identifier Text
role]

    -- Also grant access to all tables created in the future
    Query -> [Identifier] -> IO Int64
forall q.
(?modelContext::ModelContext, ToRow q, Show q) =>
Query -> q -> IO Int64
sqlExec Query
"ALTER DEFAULT PRIVILEGES IN SCHEMA public GRANT ALL PRIVILEGES ON TABLES TO ?" [Text -> Identifier
PG.Identifier Text
role]

    () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

authenticatedRole :: (?context :: context, ConfigProvider context) => Text
authenticatedRole :: Text
authenticatedRole = context
?context::context
?context
        context -> (context -> FrameworkConfig) -> FrameworkConfig
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> context -> FrameworkConfig
forall a. ConfigProvider a => a -> 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