<commit_before>== 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!

[source, haskell]
----
{-# 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.:

[source, routes]
----
/admin AdminR:
----

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

[source, routes]
----
    /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:

[source, haskell]
----
{-# 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
----<commit_msg>Add "Hierarchical routes with attributes" section.<commit_after>== 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!

[source, haskell]
----
{-# 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.:

[source, routes]
----
/admin AdminR:
----

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

[source, routes]
----
    /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:

[source, haskell]
----
{-# 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.:

[source, routes]
----
/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 hiearchical 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:

[source, routes]
----
/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/*+

{'fraction_non_alphanumeric': 0.07729741166513858, 'fraction_numerical': 0.010296917977290359, 'mean_word_length': 2.78941742383752, 'pattern_counts': {'":': 0, '<': 39, '<?xml version=': 0, '>': 47, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5987193', 'n_tokens_mistral': 4221, 'n_tokens_neox': 4078, 'n_words': 1668}