Route attributes

Route attributes allow you to set some metadata on each of your routes, in the routes description itself. The syntax is trivial: just an exclamation point followed by a value. Using it is also trivial: just use the routeAttrs function.

It’s easiest to understand how it all fits together, and when you might want it, with a motivating example. The case I personally most use this for is annotating administrative routes. Imagine having a website with about 12 different admin actions. You could manually add a call to requireAdmin or some such at the beginning of each action, but:

1. It’s tedious.

2. It’s error prone: you could easily forget one.

3. Worse yet, it’s not easy to notice that you’ve missed one.

Modifying your isAuthorized method with an explicit list of administrative routes is a bit better, but it’s still difficult to see at a glance when you’ve missed one.

This is why I like to use route attributes for this: you add a single word to each relevant part of the route definition, and then you just check for that attribute in isAuthorized. Let’s see the code!

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE QuasiQuotes           #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeFamilies          #-}
import           Data.Set         (member)
import           Data.Text        (Text)
import           Yesod
import           Yesod.Auth
import           Yesod.Auth.Dummy
data App = App
mkYesod "App" [parseRoutes|
/ HomeR GET
/unprotected UnprotectedR GET
/admin1 Admin1R GET !admin
/admin2 Admin2R GET !admin
/admin3 Admin3R GET
/auth AuthR Auth getAuth
|]
instance Yesod App where
    authRoute _ = Just $ AuthR LoginR
    isAuthorized route _writable
        | "admin" `member` routeAttrs route = do
            muser <- maybeAuthId
            case muser of
                Nothing -> return AuthenticationRequired
                Just ident
                    -- Just a hack since we're using the dummy module
                    | ident == "admin" -> return Authorized
                    | otherwise -> return $ Unauthorized "Admin access only"
        | otherwise = return Authorized
instance RenderMessage App FormMessage where
    renderMessage _ _ = defaultFormMessage
-- Hacky YesodAuth instance for just the dummy auth plugin
instance YesodAuth App where
    type AuthId App = Text
    loginDest _ = HomeR
    logoutDest _ = HomeR
    getAuthId = return . Just . credsIdent
    authPlugins _ = [authDummy]
    maybeAuthId = lookupSession credsKey
    authHttpManager = error "no http manager provided"
getHomeR :: Handler Html
getHomeR = defaultLayout $ do
    setTitle "Route attr homepage"
    [whamlet|
        <p>
            <a href=@{UnprotectedR}>Unprotected
        <p>
            <a href=@{Admin1R}>Admin 1
        <p>
            <a href=@{Admin2R}>Admin 2
        <p>
            <a href=@{Admin3R}>Admin 3
    |]
getUnprotectedR, getAdmin1R, getAdmin2R, getAdmin3R :: Handler Html
getUnprotectedR = defaultLayout [whamlet|Unprotected|]
getAdmin1R = defaultLayout [whamlet|Admin1|]
getAdmin2R = defaultLayout [whamlet|Admin2|]
getAdmin3R = defaultLayout [whamlet|Admin3|]
main :: IO ()
main = warp 3000 App

And it was so glaring, I bet you even caught the security hole about Admin3R.

Alternative approach: hierarchical routes

Another approach that can be used in some cases is hierarchical routes. This allows you to group a number of related routes under a single parent. If you want to keep all of your admin routes under a single URL structure (e.g., /admin), this can be a good solution. Using them is fairly simple. You need to add a line to your routes declaration with a path, a name, and a colon, e.g.:

/admin AdminR:

Then, you place all children routes beneath that line, and indented at least one space, e.g.:

    /1 Admin1R GET
    /2 Admin2R GET
    /3 Admin3R GET

To refer to these routes using type-safe URLs, you simply wrap them with the AdminR constructor, e.g. AdminR Admin1R. Here is the previous route attribute example rewritten to use hierarchical routes:

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE QuasiQuotes           #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeFamilies          #-}
import           Data.Set         (member)
import           Data.Text        (Text)
import           Yesod
import           Yesod.Auth
import           Yesod.Auth.Dummy
data App = App
mkYesod "App" [parseRoutes|
/ HomeR GET
/unprotected UnprotectedR GET
/admin AdminR:
    /1 Admin1R GET
    /2 Admin2R GET
    /3 Admin3R GET
/auth AuthR Auth getAuth
|]
instance Yesod App where
    authRoute _ = Just $ AuthR LoginR
    isAuthorized (AdminR _) _writable = do
        muser <- maybeAuthId
        case muser of
            Nothing -> return AuthenticationRequired
            Just ident
                -- Just a hack since we're using the dummy module
                | ident == "admin" -> return Authorized
                | otherwise -> return $ Unauthorized "Admin access only"
    isAuthorized _route _writable = return Authorized
instance RenderMessage App FormMessage where
    renderMessage _ _ = defaultFormMessage
-- Hacky YesodAuth instance for just the dummy auth plugin
instance YesodAuth App where
    type AuthId App = Text
    loginDest _ = HomeR
    logoutDest _ = HomeR
    getAuthId = return . Just . credsIdent
    authPlugins _ = [authDummy]
    maybeAuthId = lookupSession credsKey
    authHttpManager = error "no http manager provided"
getHomeR :: Handler Html
getHomeR = defaultLayout $ do
    setTitle "Route attr homepage"
    [whamlet|
        <p>
            <a href=@{UnprotectedR}>Unprotected
        <p>
            <a href=@{AdminR Admin1R}>Admin 1
        <p>
            <a href=@{AdminR Admin2R}>Admin 2
        <p>
            <a href=@{AdminR Admin3R}>Admin 3
    |]
getUnprotectedR, getAdmin1R, getAdmin2R, getAdmin3R :: Handler Html
getUnprotectedR = defaultLayout [whamlet|Unprotected|]
getAdmin1R = defaultLayout [whamlet|Admin1|]
getAdmin2R = defaultLayout [whamlet|Admin2|]
getAdmin3R = defaultLayout [whamlet|Admin3|]
main :: IO ()
main = warp 3000 App

Hierarchical routes with attributes

Of course, you can mix the two approaches. Children of a hierarchical route will inherit the attributes of their parents, e.g.:

/admin AdminR !admin:
    /1 Admin1R GET !1
    /2 Admin2R GET !2
    /3 Admin3R Get !3

AdminR Admin1R has the admin and 1 attributes.

With this technique, you can use the admin attributes in the isAuthorized function, like in the first example. You are also sure that you won’t forget any attributes as we did with Admin3R. Compared to the original code corresponding to the hierarchical route, this method has no real benefit : both methods being somehow equivalent. We replaced the pattern matching on (AdminR _) with "admin" `member` routeAttrs route. However, the benefit becomes more obvious when the admin pages are not all grouped under the same url structures but belong to different subtrees, e.g:

/admin AdminR !admin:
    /1 Admin1R GET
    /2 Admin2R GET
    /3 Admin3R Get
/a AR !a:
  /1 A1R GET
  /2 A2R GET
  /admin AAdminR !admin:
    /1 AAdmin1R GET
    /2 AAdmin2R GET

The pages under /admin and /a/admin have all the admin attribute and can be checked using "admin" `member` routeAttrs route. Pattern matching on (AdminR _) will not work for this example and only match /admin/* routes but not /a/admin/\*