tl/dr; I tried to expand the cookie-based auth I implemented in servant and failed. While I’ll probably try again some other day, for now I just resorted to writing functions to get the functions for a user and do checking directly in my handlers

Here’s the tale of how I tried to add Role checking (based on my application’s defined Role type) to my servant app, and ran into a few issues and things I didn’t understand and ultimately failed. While unfortunately there isn’t some code I can show you that’s the working version, maybe when I return to this problem (I assume during the mythical time I give myself to do code cleanup), I’ll update this post with a working solution – for now, let’s watch my past failure from the future.

This post is bit in a rambling, stream-of-consciousness style (as it’s being produced directly from my notes with minimal editing) – If you don’t like these kinds of posts you should probably stop reading right now. If you’re interested in how I created the cookie-based auth combinator, check out the previous post and maybe check out something like servant-auth-cookie (and the wiki inside) for handling sessions for your own servant front-facing API.

The beginning

When thinking of how to do role checking, I thought it would be amazing if I could do something like specify a role along with the cookie auth and handle role checking even more declaratively than checking roles in individual handlers. This opens up a few options, like easily restricting a whole group of endpoints to a Role, like Administrator, and never having to worry about it again. This also helps to reduce the amount of code in the handlers.

I start looking at the documentation page for extending servant, and see that the typeclass I need to implement seems to be HasServer to make the new combinator I wanted. After heading to the docs for HasServer and I observe some usages in the standard combinators to try and get a feel for how to implement the interface. To start, I copy the instance code for the Valut combinator, and we’re off to the races.

Into the type furnace

The first thing I don’t recognize is the use of Data.Typeable – luckily Typeable is very easily auto-derived so I don’t have to worry too hard about writing any new code. The line I ended up writing (when still figuring everything out) was:

data Combinator a deriving Typeable

While looking at the code for vault, I see passToServer which has lots of uses across other provided combinators as well so I take a look at the source. At this point I’m wondering how exaclty I want to implement the thing that checks the Role, assuming the Role was provided as part of the combinator (ex. HasRole Administrator). Another candidate for a good function to use was addParameterCheck – I understood this to mean (at the time) that it was checking a parameter to the Handler – and this would make it a good fit, I wanted to check the Session that was coming into the handler, which contains the user information I was interested in.

As I try and use addParameterCheck, I see more and more the references to Delayed and start to figure out what it’s for – It looks like it’s a kitchen sink of state/actions for things that have to do with requests – the functions that check the parameters, the action that eventually does the acutal work, and some other stuff.

Here’s what the Delayed looks like:

data Delayed env c where
  Delayed :: { capturesD :: env -> DelayedIO captures
             , methodD   :: DelayedIO ()
             , authD     :: DelayedIO auth
             , acceptD   :: DelayedIO ()
             , contentD  :: DelayedIO contentType
             , paramsD   :: DelayedIO params
             , headersD  :: DelayedIO headers
             , bodyD     :: contentType -> DelayedIO body
             , serverD   :: captures
                         -> params
                         -> headers
                         -> auth
                         -> body
                         -> Request
                         -> RouteResult c
} -> Delayed env c

FUTURE-NOTE This is defined as a GADT, which I actually end up messing with later. I didn’t realize this at the time, but it probably would have helped in my understanding.

Looking at the Delayed, it looks like what I want to do is add an authentication check – likely by transforming authD somehow. authD’s type, DelayedIO auth…

What’s a DelayedIO auth?

After figuring out what a Delayed was, it was time to try and figure out what a DelayedIO auth (I read this as a DelayedIO action that produces an auth is a little confusing to me (though it makes a lot more sense as I write this blog post since it’s been a while) – so I try to figure out what it is and stumble upon these lines in the code:

-- | Computations used in a 'Delayed' can depend on the
-- incoming 'Request', may perform 'IO, and result in a
-- 'RouteResult, meaning they can either suceed, fail
-- (with the possibility to recover), or fail fatally.
--
newtype DelayedIO a = DelayedIO { runDelayedIO' :: ReaderT Request (ResourceT (RouteResultT IO)) a }
  deriving
    ( Functor, Applicative, Monad
    , MonadIO, MonadReader Request
    , MonadBase IO
    , MonadThrow
    , MonadResource
)

So at this point from what I understand, DelayedIO is a thing that runs 3 levels of monads and produces a result (again I understand this a lot better now, but I’m trying to imagine what I was thinking previously). Based on the information I had, it seemed like the best plan was to get the auth details from the DelayedIO and then check and maybe trigger route failures based on the results of the auth check (and then the role check). I assumed that auth (that I had to eventually return from authD) was related to the AuthProtect machinery used for generalized auth in servant

Attempting to mimic AuthProtect

Along the way, one approach I thought would work would be mimicing AuthProtect to basically offer the same API as it offered before but with a Role checking function attached to the definition. Something like an AuthProtectWithRole. I started looking at the auth documentation, and reading it was absolutely eye-opening as to how AuthProtect worked, and how the route implementation worked as well. It was easy to see that authHandler was really just wrapping functionality I wrote (signature Request -> AuthHandler Request X), by finding it in the context, running it, and eithe failFataling or continuing.

Unfortunately, after this revelation, I got promptly very lost again – as I tried to extend the AuthProtect machinery that I had already to check a client AND a specified Role. I was very confused about many of the intermediary types, and what various functions were supposed to return.

As close as I was going to get

After a good night’s rest (one of my favorite methods of boosting productivity and problem solving skills), I was able to understand the types a little more and get something that would compile:

data HasRole a deriving Typeable

instance (KnownSymbol a, HasServer api context, HasContextEntry context (V.Key (Session IO ByteString SessionInfo))) =>
    HasServer (HasRole a :> api) context where
  type ServerT (HasRole a :> api) m = SessionInfo -> ServerT api m

  route :: Proxy (HasRole a:> api)
       -> Context context
       -> Delayed env (Server (HasRole a :> api))
       -> Router env
  route Proxy context subserver =
      let sessionKey = (getContextEntry context) :: V.Key (Session IO ByteString SessionInfo)
          roleStr = symbolVal (Proxy :: Proxy a)
          authCheck req = case maybeSession of
                            Nothing -> delayedFailFatal Err.unauthorized
                            Just origSession@(get,_) -> do
                                              maybeSession <- liftIO $ get sessionInfoKey
                                              case maybeSession of
                                                Nothing -> delayedFailFatal Err.unauthorized
                                                Just session -> return session
                                                -- TODO actually check roleStr against the role

              where
                maybeSession = V.lookup sessionKey $ vault req

      --in route (Proxy :: Proxy api) context (passToServer subserver authCheck)
      in route (Proxy :: Proxy api) context (addAuthCheck subserver $ withRequest authCheck)

Of course, it almost works, but not quite – The compiler was telling me I needed to do two things (though likely only one of these things was actually necessary):

1. Write the NT(Natural Transformation) that the compiler was pestering me about.

2. Change The monad that the type is decomposing to (in type ServerT (HasRole a :> api) m = SessionInfo -> ServerT api m, change the last ServerT to something else, like WithApplicationGlobals (the custom monad that I’m using)

Figuring out Natural Transformations

At this point I was pretty stumped (I was not very used to/experienced with NT at all then, and wouldn’t even consider myself good at using them now, though I am much more comfortable with them). I asked a little bit on IRC and user alpounet (thanks a lot!) was helpful in suggesting that he normally just modifies AuthProtect altogeher for things like this.

This is something I also considered, but the question is how would I add another type variable to AuthProtect? The right path seemed to be:

• Copy code for authprotect
• Add type variable
• Do the magic using Proxy, symbolVal (along with KnownSymbol, from GHC.TypeLits) to change the raw type variable into a String, then back into a Type for comparison/checking
• ???
• Profit

While this option certainly seemed like a good one, I stuck to writing the natural tranformation/figuring out if I needed to change the handler (this proved to be a mistake, and likely modifying AuthProtect altogether was the way to go).

Getting even more help

After looking on the internet, I found another guide which helped explain custom auth a little more.

The end of the road :(

After doing all this work and figuring out how to change the base Monad for the combinator I was workign on, I was suspicious that I didn’t actually need a brand new NT but actually just needed to fix the combinator to return someting else.

At this point, I figured I’d wasted too much time, and wanted to move on from trying to do this optimization (that some might consider premature) – it made the code uglier, but the good news is that the code works, and is well-named/easy to read at least:

requireRole :: Role -> SessionInfo -> WithApplicationGlobals Handler SessionInfo
requireRole r s = case roleMatches of
                    False -> throwError Err.unauthorized
                    True  -> return s
    where
      roleMatches = (getRoleFromSessionInfo s) == r

requirePermissions :: [Permission] -> SessionInfo -> WithApplicationGlobals Handler SessionInfo
requirePermissions ps s = case permissionsMatch of
                            False -> throwError Err.unauthorized
                            True  -> return s
    where
      userPermissions = sessionUserPermissions s
      permissionsMatch = all (`elem`userPermissions) ps

Hope you enjoyed this trip down the rabbit hole! Unfortunately this time I didn’t make it out and I’ not sure when I’ll try and approach the problem again, but looking forward to the next time I do (I’ll update this post)!