Repository: hasura/graphql-engine
File: server/src-lib/Hasura/RQL/DDL/Permission.hs (Haskell)

Code before:
import qualified Data.HashMap.Strict                as HM
import qualified Data.HashSet                       as HS
import qualified Data.Text                          as T

-- Insert permission
data InsPerm
  = InsPerm
  { ipCheck   :: !BoolExp
  , ipSet     :: !(Maybe ColVals)
  , ipColumns :: !(Maybe PermColSpec)
  } deriving (Show, Eq, Lift)

$(deriveJSON (aesonDrop 2 snakeCase){omitNothingFields=True} ''InsPerm)

type InsPermDef = PermDef InsPerm
type CreateInsPerm = CreatePerm InsPerm

buildViewName :: QualifiedTable -> RoleName -> PermType -> QualifiedTable
buildViewName qt rn pt = QualifiedObject hdbViewsSchema tableName
  where
    tableName = TableName $ T.pack $ show hash
    -- Blake2b_224 generates 56 character length hash
    hash :: CH.Digest CH.Blake2b_224 =
      CH.hash $ txtToBs $ roleNameToTxt rn <> "__" <> T.pack (show pt) <> "__" <> qualObjectToText qt

buildView :: QualifiedTable -> QualifiedTable -> Q.Query
buildView tn vn =
  Q.fromBuilder $ mconcat
  [ "CREATE VIEW " <> toSQL vn
  , " AS SELECT * FROM " <> toSQL tn
  ]

dropView :: QualifiedTable -> Q.Tx ()
dropView vn =
  Q.unitQ dropViewS () False
  where
    dropViewS = Q.fromBuilder $
      "DROP VIEW " <> toSQL vn

procSetObj
  :: (QErrM m)
  => TableInfo PGColumnInfo -> Maybe ColVals
  -> m (PreSetColsPartial, [Text], [SchemaDependency])
procSetObj ti mObj = do
  (setColTups, deps) <- withPathK "set" $
    fmap unzip $ forM (HM.toList setObj) $ \(pgCol, val) -> do
      ty <- askPGType fieldInfoMap pgCol $
        "column " <> pgCol <<> " not found in table " <>> tn
      sqlExp <- valueParser (PGTypeScalar ty) val
      let dep = mkColDep (getDepReason sqlExp) tn pgCol
      return ((pgCol, sqlExp), dep)

Review comment (suggestion):
A thought: it isn’t immediately clear to someone reading this code *why* we’re doing this hashing. This might be a good situation for [something like GHC’s “notes” system](https://www.stackbuilders.com/news/the-notes-of-ghc). The idea is to create a long-form comment somewhere, like this:

```haskell
{- Note [Postgres identifier length limitations]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Postgres truncates identifiers to a maximum of 63 characters by default (see
https://www.postgresql.org/docs/12/sql-syntax-lexical.html#SQL-SYNTAX-IDENTIFIERS). This causes
problems for A, B, and C because of X and Y, so we work around it by doing Z. -}
```

Except obviously `A`, `B`, `C`, etc. are replaced with real explanations. :) Then somewhere else in the code you can write

```haskell
-- see Note [Postgres identifier length limitations]
hash :: CH.Digest CH.Blake2b_224 =
```

wherever the note is relevant. That way, explanations for tricky concepts can be centralized in one place, and they can be referenced from other places in the code. I think there is already at least one or two places in `graphql-engine` where we do some work to work around Postgres’s identifier length limitation, so it would be great to put a note somewhere and add comments in all those places referencing it!

Code after:
import qualified Data.HashMap.Strict                as HM
import qualified Data.HashSet                       as HS
import qualified Data.Text                          as T

-- Insert permission
data InsPerm
  = InsPerm
  { ipCheck   :: !BoolExp
  , ipSet     :: !(Maybe ColVals)
  , ipColumns :: !(Maybe PermColSpec)
  } deriving (Show, Eq, Lift)

$(deriveJSON (aesonDrop 2 snakeCase){omitNothingFields=True} ''InsPerm)

type InsPermDef = PermDef InsPerm
type CreateInsPerm = CreatePerm InsPerm

buildViewName :: QualifiedTable -> RoleName -> PermType -> QualifiedTable
buildViewName qt rn pt = QualifiedObject hdbViewsSchema tableName
  where
    -- Generate a unique hash for view name from role name, permission type and qualified table.
    -- See Note [Postgres identifier length limitations].
    -- Black2b_224 generates 56 character hash. See Note [Blake2b faster than SHA-256].
    -- Refer https://github.com/hasura/graphql-engine/issues/3444.
    tableName = TableName $ T.pack $ show hash
    hash :: CH.Digest CH.Blake2b_224 =
      CH.hash $ txtToBs $ roleNameToTxt rn <> "__" <> T.pack (show pt) <> "__" <> qualObjectToText qt

buildView :: QualifiedTable -> QualifiedTable -> Q.Query
buildView tn vn =
  Q.fromBuilder $ mconcat
  [ "CREATE VIEW " <> toSQL vn
  , " AS SELECT * FROM " <> toSQL tn
  ]

dropView :: QualifiedTable -> Q.Tx ()
dropView vn =
  Q.unitQ dropViewS () False
  where
    dropViewS = Q.fromBuilder $
      "DROP VIEW " <> toSQL vn

procSetObj
  :: (QErrM m)
  => TableInfo PGColumnInfo -> Maybe ColVals
  -> m (PreSetColsPartial, [Text], [SchemaDependency])
procSetObj ti mObj = do
  (setColTups, deps) <- withPathK "set" $
    fmap unzip $ forM (HM.toList setObj) $ \(pgCol, val) -> do
      ty <- askPGType fieldInfoMap pgCol $
        "column " <> pgCol <<> " not found in table " <>> tn