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:
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 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
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
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/\*