Using Databases inside of Snaplet Auth Restricted Routes

The github repo for this code is at here.

tldr; use this instance:

instance HasPostgres (Handler App (AuthManager App)) where
    getPostgresState = withTop pg get

The app we’re using was built by running snap init and adding the following code:

src/Application.hs

In src/Application.hs we’ve added the following imports:

import Snap.Snaplet.PostgresqlSimple

and the following definition to our App datatype:

,_pg :: Snaplet Postgres

src/Site.hs

In src/Site.hs we’ve added the following language extensions:

{-# LANGUAGE FlexibleInstances #-}

Imports:

-- for "get"
import Control.Monad.State.Class
-- for "liftIO"
import           Control.Monad.IO.Class
--for "writeJSON"
import           Snap.Extras.JSON
-- for Non Snaplet-Auth related database queries
import           Snap.Snaplet.PostgresqlSimple
-- for Snaplet-Auth backed
import           Snap.Snaplet.Auth.Backends.PostgresqlSimple

Instances:

instance HasPostgres (Handler b App) where
getPostgresState = with pg get

instance HasPostgres (Handler App (AuthManager App)) where getPostgresState =
withTop pg get

and Snaplet Init code:

What's Going On

We've also defined a convenience function needsAuth to restrict our "/postgres" route to only logged in users.

needsAuth :: Handler App (AuthManager App) () -> Handler
App App () needsAuth x = with auth $ requireUser auth (redirect "/") x

getFromPostgres does the dirty work for us by querying a table that was created as part of the Snaplet-Auth backend. It will return a list of all users.

getFromPostgres :: Handler App (AuthManager App) ()
getFromPostgres = do --get the results results

"/postgres" is the url to hit to check to see if it's working.

, ("/postgres", needsAuth getFromPostgres)

The Instance

What's really doing the heavy lifting of using the postgres snaplet inside of the auth snaplet's route is this instance:

instance HasPostgres (Handler App (AuthManager App)) where
getPostgresState = withTop pg get

The important difference from the instance above it is withTop which can be found here.

From the docs:

-- | Like 'with' but doesn't impose the requirement that the action -- being run be a descendant of the current snaplet.

Essentially, the auth snaplet doesn't know anything about the postgres snaplet as we've instantiated it (it doesn't keep around a reference from the Backend module), so we have to ask the parent context (using withTop).