[support for login and logout under simple circumstances
Jeremy Shaw <jeremy@seereason.com>**20110222173454
 Ignore-this: ec076b19f701ba9c55d224c8a0705ff
] hunk ./AuthURL.hs 14
-instance Happstack (RouteT AuthURL (ServerPartT IO))
-
addfile ./Pages/Home.hs
hunk ./Pages/Home.hs 1
+{-# OPTIONS_GHC -F -pgmFtrhsx #-}
+module Pages.Home where
+
+import AuthURL
+import Happstack.Server
+import HSP
+import Pages.AppTemplate
+import SiteURL
+import Profile
+import Web.Routes
+import Types
+
+homePage :: RouteT SiteURL (ServerPartT IO) Response
+homePage =
+    do mUserId <- getUserId
+       case mUserId of
+         Nothing -> 
+             appTemplate "not logged in." ()
+               <div>
+                <p>You can login <a href=(U_Auth A_Login)>here</a>.</p>
+               </div>
+         (Just (UserId uid)) ->
+             appTemplate "logged in." ()
+               <div>
+                <p>You are logged in as <% show uid %>. You can logout <a href=(U_Auth A_Logout)>here</a>.</p>
+               </div>
hunk ./Pages/Login.hs 102
-pickProfile :: RouteT ProfileURL (ServerPartT IO) Response
-pickProfile =
+pickProfile :: String -> RouteT ProfileURL (ServerPartT IO) Response
+pickProfile onLoginURL =
hunk ./Pages/Login.hs 112
-                          return $ toResponse $ "logged in as " ++ show uid
+                          seeOther onLoginURL (toResponse onLoginURL)
hunk ./Pages/Login.hs 115
-                          return $ toResponse $ "logged in as " ++ show (userId profile)
+                          seeOther onLoginURL (toResponse onLoginURL)
hunk ./Pages/Login.hs 118
-             return $ toResponse $ "logged in as " ++ show uid
+             seeOther onLoginURL (toResponse onLoginURL)
addfile ./Pages/Logout.hs
hunk ./Pages/Logout.hs 1
+{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeFamilies, UndecidableInstances #-}
+{-# OPTIONS_GHC -F -pgmFtrhsx #-}
+module Pages.Logout where
+
+import AuthURL
+import Pages.AppTemplate
+import State.Auth
+import Happstack.Server
+import HSP
+import Web.Routes
+import Web.Routes.Happstack
+
+
+logoutPage :: RouteT AuthURL (ServerPartT IO) Response
+logoutPage =
+    do deleteAuthCookie
+       appTemplate "Logout" () 
+         <p>You are now logged out. Click <a href=A_Login>here</a> to log in again.</p>
+       
hunk ./ProfileURL.hs 16
-instance Happstack (RouteT ProfileURL (ServerPartT IO))
-
hunk ./State/Auth.hs 35
+    , deleteAuthCookie
hunk ./State/Auth.hs 416
+deleteAuthCookie :: (Happstack m, Alternative m) => m ()
+deleteAuthCookie =
+    do mTokenStr <- optional $ lookCookieValue "authToken"
+       case mTokenStr of
+         Nothing         -> return ()
+         (Just tokenStr) -> 
+             do expireCookie "authToken"
+                update (DeleteAuthToken tokenStr)
+
hunk ./State/Auth.hs 428
-       liftIO $ putStrLn $ "authToken cookie value = " ++ show mTokenStr
hunk ./State/Auth.hs 440
-
-
-
hunk ./Types.hs 14
+import Web.Routes.Happstack
+import Web.Routes.MTL
hunk ./Types.hs 35
+instance (Happstack m) => Happstack (RouteT url m)
hunk ./demo.hs 14
+import Pages.Home
hunk ./demo.hs 16
+import Pages.Logout
hunk ./demo.hs 90
-handle U_HomePage          = homePage
-handle (U_Auth auth)       = do onAuthURL <- showURL (U_Profile P_PickProfile)
+handle url =
+    case url of
+      U_HomePage          -> homePage
+      (U_Auth auth)       -> do onAuthURL <- showURL (U_Profile P_PickProfile)
hunk ./demo.hs 95
-handle (U_Profile profile) = nestURL U_Profile $ handleProfile profile
+      (U_Profile profile) -> nestURL U_Profile $ handleProfile profile
hunk ./demo.hs 101
+      A_Logout                  -> logoutPage
hunk ./demo.hs 108
-      P_PickProfile -> pickProfile
-
-homePage :: RouteT SiteURL (ServerPartT IO) Response
-homePage = 
-    appTemplate "this page rocks." ()
-      <div>
-       <p>You can login <a href=(U_Auth A_Login)>here</a>.</p>
-      </div>
+      P_PickProfile -> pickProfile "/"