feat: configurable role settings

src/PostgREST/Config/Database.hs

@@ -3,11 +3,17 @@
 module PostgREST.Config.Database
   ( pgVersionStatement
   , queryDbSettings
+  , queryRoleSettings
   , queryPgVersion
+  , RoleSettings
   ) where
 
+import Control.Arrow ((***))
+
 import PostgREST.Config.PgVersion (PgVersion (..))
 
+import qualified Data.HashMap.Strict as HM
+
 import qualified Hasql.Decoders             as HD
 import qualified Hasql.Encoders             as HE
 import           Hasql.Session              (Session, statement)
@@ -19,6 +25,8 @@ import Text.InterpolatedString.Perl6 (q)
 
 import Protolude
 
+type RoleSettings = (HM.HashMap ByteString [(ByteString, ByteString)])
+
 queryPgVersion :: Bool -> Session PgVersion
 queryPgVersion prepared = statement mempty $ pgVersionStatement prepared
 
@@ -61,5 +69,45 @@ dbSettingsStatement = SQL.Statement sql HE.noParams decodeSettings
     |]
     decodeSettings = HD.rowList $ (,) <$> column HD.text <*> column HD.text
 
+queryRoleSettings :: Bool -> Session RoleSettings
+queryRoleSettings prepared =
+  let transaction = if prepared then SQL.transaction else SQL.unpreparedTransaction in
+  transaction SQL.ReadCommitted SQL.Read $ SQL.statement mempty $ roleSettingsStatement prepared
+
+roleSettingsStatement :: Bool -> SQL.Statement () RoleSettings
+roleSettingsStatement = SQL.Statement sql HE.noParams decodeSettings
+  where
+    sql = [q|
+      with
+      role_setting as (
+        select r.rolname, unnest(r.rolconfig) as setting
+        from pg_auth_members m
+        join pg_roles r on r.oid = m.roleid
+        where member = current_user::regrole::oid
+      ),
+      kv_settings AS (
+        SELECT
+          rolname,
+          substr(setting, 1, strpos(setting, '=') - 1) as key,
+          substr(setting, strpos(setting, '=') + 1) as value
+        FROM role_setting
+      )
+      select rolname, array_agg(row(key, value))
+      from kv_settings
+      group by rolname;
+    |]
+    decodeSettings = HM.fromList . map (bimap encodeUtf8 ((encodeUtf8 *** encodeUtf8) <$>)) <$> HD.rowList aRow
+    aRow :: HD.Row (Text, [(Text, Text)])
+    aRow = (,) <$> column HD.text <*> compositeArrayColumn ((,) <$> compositeField HD.text <*> compositeField HD.text)
+
 column :: HD.Value a -> HD.Row a
 column = HD.column . HD.nonNullable
+
+compositeField :: HD.Value a -> HD.Composite a
+compositeField = HD.field . HD.nonNullable
+
+compositeArrayColumn :: HD.Composite a -> HD.Row [a]
+compositeArrayColumn = arrayColumn . HD.composite
+
+arrayColumn :: HD.Value a -> HD.Row [a]
+arrayColumn = column . HD.listArray . HD.nonNullable