I'd like to use the Wai HttpAuth Middleware to hide a few pages behind HTTP basic auth. For this the HttpAuth middleware provides authIsProtected :: !(Request -> IO Bool)
.
To implement authIsProtected
I need to check if the URL is admin-only; it seems like the best way to do that is to create route attributes in the routes
file, then access them using this function: routeAttrs :: RouteAttrs a => Route a -> Set Text
.
However, I don't have access to a Route
in the authIsProtected
function, just a Wai Request
. Is there a way I can go from a Wai Request
to a Route
? I figure Yesod must do this under the hood but I couldn't figure out where/how.
Its possible I should be doing the authentication in isAuthorized
instead, where I have access to the Route
, but I'm not sure I can run the HTTP basic auth from there.
makeApplication :: AppConfig DefaultEnv Extra -> IO Application
makeApplication conf = do
foundation <- makeFoundation conf
app <- toWaiAppPlain foundation
return $ basicAuth
(\u p -> return $ u == "username" && p == "password")
("My Realm" { authIsProtected = \waiRequest -> do
-- Would like to access a route / route attrs here
return True } :: AuthSettings)
$ app
Edit: Here's what I came up with:
import Network.Wai (queryString, pathInfo, Request)
import Network.HTTP.Types.URI (queryToQueryText)
import Control.Arrow (second)
import Data.Maybe (fromMaybe)
import Yesod (Route)
import Data.Set (member)
makeApplication :: AppConfig DefaultEnv Extra -> IO Application
makeApplication conf = do
foundation <- makeFoundation conf
-- Create the WAI application and apply middlewares
app <- toWaiAppPlain foundation
return $ basicAuth
(\u p -> return $ u == "username" && p == "password")
("My Realm" { authIsProtected = \waiReq -> do
let mRoute = parseRoute(pathInfo waiReq,textQueryString waiReq) :: Maybe (Route App)
return $ maybe False adminOnly mRoute
} :: AuthSettings)
$ app
adminOnly :: Route App -> Bool
adminOnly r = "admin" `member` routeAttrs r
-- Copied from Yesod.Core.Internal.Request
textQueryString :: Request -> [(Text, Text)]
textQueryString = map (second $ fromMaybe "") . queryToQueryText . queryString
Does parseRoute provide you what you're looking for? You just need to team it up with pathInfo and queryString.