agentm / agentm/project-m36

Making `RelationalError` extendable/customizeable

Abierto
#305 7 comentarios 0 reacciones 0 asignados Ver en GitHub
Lenguaje dominante
Haskell
Estrellas
952
Forks
50
Métricas de merge de PR
Sin PR fusionados en 30 d

Descripción

Given that most API calls take a `Connection` and `SessionId` and return an `Either RelationalError a` result type, I have made a `ReaderT` + `ExceptT` monad stack and wrapped the API calls in it. Like this:

```haskell
data DBEnv = DBEnv { getHead :: Text
, getConnection :: Connection
, getSessionId :: SessionId
}

type Action a = ReaderT DBEnv (ExceptT RelationalError IO) a

connInfo :: ConnectionInfo
connInfo = RemoteConnectionInfo
"my-db"
"127.0.0.1"
"6543"
emptyNotificationCallback

conn :: IO Connection
conn = handleIOError $ connectProjectM36 connInfo

handleIOError :: Show e => IO (Either e a) -> IO a
handleIOError m = do
v <- m
handleError v

handleError :: Show e => Either e a -> IO a
handleError eErr = case eErr of
Left err -> print err >> error "Died due to errors."
Right v -> pure v
```

The wrapped API calls look like this:
```haskell
execRelExp :: RelationalExpr -> Action Relation
execRelExp rExp = do
env <- ask
lift
$ ExceptT
$ executeRelationalExpr (getSessionId env) (getConnection env) rExp
```

Then I use `runDB` to run the stack:
```haskell
runDB :: Action a -> IO (Either RelationalError a)
runDB a = do
c <- liftIO conn
sessionId <- liftIO $ createSessionAtHead c "master"
case sessionId of
Right sid -> withTransaction
sid
c
(runExceptT
(runReaderT
a
DBEnv { getHead = "master", getConnection = c, getSessionId = sid }))
(autoMergeToHead sid c UnionMergeStrategy "master")
Left e -> return $ Left e
```

Now let's say I want a function that given a RelVar name, returns its contents. But it also makes sure the user making the call has read access to that RelVar. To do this, I would do something like this:
```haskell
checkReadAccess :: UserId -> RelVarName -> Action Bool
checkReadAccess uid rv = ... -- see if the user has access to that rel var

getRelVar :: RelVarName -> Action Relation
getRelVar rv = do
let userId = ... -- get user ID from http session or something
hasReadAccess <- checkReadAccess userId rv
if hasReadAccess
then execRelExp $ RelationVariable rv ()
else throwError (AccessError userId rv) -- need to signal this problem somehow
```
This whole thing can go wrong in multiple ways, some of which come from Project:M36 and some are app specific. (i.e. rel var is not defined or user is not logged in or user has no read access). If somehow `RelationalError` could be extended to allow for app specific errors, things could become very easy in monad stacks and very composable in general.

So far I can't think of a way to do this cleanly. Any suggestions are welcome!

Guía de contribución

No hay ninguna guía de contribución indexada para este repositorio

Evaluación

Este issue todavía no se ha evaluado.

Recibe los nuevos issues en tu correo

Un resumen breve de issues de GitHub para principiantes.