From aff7722e12fc3cbd6ad66c94f5852dd12b1fd074 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Wed, 6 Jan 2010 21:27:56 +0200
Subject: [PATCH] Approot used in rpxnow login

---
 TODO                  | 1 +
 Yesod/Helpers/Auth.hs | 5 +++--
 2 files changed, 4 insertions(+), 2 deletions(-)

diff --git a/TODO b/TODO
index a09e2e82..a44ffdf5 100644
--- a/TODO
+++ b/TODO
@@ -3,3 +3,4 @@ Cleanup Parameter stuff. Own module? Interface with formlets?
 Authentication via e-mail address built in. (eaut.org)
 OpenID 2 stuff (for direct Google login).
 Languages (read languages header, set language cookie)
+Approot and trailing slash missing
diff --git a/Yesod/Helpers/Auth.hs b/Yesod/Helpers/Auth.hs
index be5914eb..ed28c533 100644
--- a/Yesod/Helpers/Auth.hs
+++ b/Yesod/Helpers/Auth.hs
@@ -129,6 +129,7 @@ authOpenidComplete = do
 rpxnowLogin :: YesodAuth y => Handler y HtmlObject
 rpxnowLogin = do
     ay <- getYesod
+    let (Approot ar) = approot ay
     apiKey <- case rpxnowApiKey ay of
                 Just x -> return x
                 Nothing -> notFound
@@ -138,8 +139,8 @@ rpxnowLogin = do
                 Nothing -> runRequest $ getParam "dest"
                 Just d -> return d
     let dest = case dest' of
-                Nothing -> "/"
-                Just "" -> "/"
+                Nothing -> ar
+                Just "" -> ar
                 Just ('#':rest) -> rest
                 Just s -> s
     ident <- Rpxnow.authenticate apiKey token