Chapter 29. Route Attributes

Route attributes allow you to set some metadata on each of your routes, in the route 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 all this fits together, and when you might want to use 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:

  • It’s tedious.

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

  • 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 because 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 plug-in
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 hierarchical routes is fairly simple. You need to add a line to your routes declaration with a path, a name, and a colon:

/admin AdminR:

Then, you place all child routes beneath that line, indented at least one space:

    /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 because 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 plug-in
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

..................Content has been hidden....................

You can't read the all page of ebook, please click here login for view all page.
Reset