Commits

Luke Plant  committed 5aa538d

Finished implementing redirection for login/logout.

  • Participants
  • Parent commits 03679e4

Comments (0)

Files changed (3)

         feed >= 0.3.7,
         time >= 1.1.2,
         xml >= 1.3.4,
+        cgi >= 3000.0.0,
         ella >= 0.1.2
   Main-is: BlogCgi.hs
   hs-source-dirs: src

File src/Blog/Views.hs

 import Ella.Response
 import Ella.Utils (addHtml)
 import Maybe (fromMaybe, isJust, fromJust, catMaybes)
+import Network.CGI.Protocol (formEncode, urlEncode)
 import System.Time (ClockTime(..), toUTCTime)
 import Text.Atom.Feed (Feed)
 import Text.Atom.Feed.Export (xmlFeed)
 standardResponseTT req template =
     let csrffield = mkCsrfField req
         t2 = setAttribute "csrffield" csrffield template
-        t3 = setAttribute "currentpath" (Settings.root_url ++ pathInfo req) t2
+        qs = formEncode (allGET req)
+        t3 = setAttribute "currentpath" (urlEncode (Settings.root_url ++ pathInfo req ++ (if not $ null qs then "?" ++ qs else ""))) t2
         rendered = render t3
     in buildResponse [ addContent rendered
                      ] utf8HtmlResponse
 
 -- | Delete auth cookies and redirect.
 logoutView req =
-    return $ Just $ deleteCookie "username" $ redirectResponse indexUrl
+    let redirectUrl = getGET req "r" `captureOrDefault` indexUrl
+    in return $ Just $ deleteCookie "username" $ redirectResponse redirectUrl
 
 --
 -- Admin views

File src/templates/pageend.st

         </div>
       </div>
       <div id="loginlinks">
-        <a href="/blog/login/" id="id_loginlink">Login</a><br/>
-        <a href="/blog/logout/" id="id_logoutlink">Logout</a><br/>
+        <a href="/blog/login/?r=$currentpath$" id="id_loginlink">Login</a><br/>
+        <a href="/blog/logout/?r=$currentpath$" id="id_logoutlink">Logout</a><br/>
         <a href="/blog/admin/">Admin</a><br/>
         $if(editpageurl)$
           <a href="$editpageurl$">Edit</a><br/>