[logout action works
thomashartman1@gmail.com**20080904232333] hunk ./src/Controller.hs 48
-     [tmpl] -> ( ioMsgToWeb . tutlayout [] ) (traceMsg "tmpl: " tmpl)
+     [tmpl] -> ( tutlayoutWeb [] ) (traceMsg "tmpl: " tmpl)
hunk ./src/Controller.hs 52
-    exactdir "/" [ ioMsgToSp $ tutlayout [] "home" ]
+    exactdir "/" [ tutlayoutSp [] "home" ]
hunk ./src/Controller.hs 58
-            dir "login" [ methodSP POST loginaction ]
+            dir "login" [ methodSP POST $ withData loginPage ]
hunk ./src/Controller.hs 60
+            , dir "logout" logoutPage 
hunk ./src/Controller.hs 67
-  ioMsgToSp $ tutlayout [("userList", (show users))] "view-all-users" 
+  tutlayoutSp [("userList", (show users))] "view-all-users" 
hunk ./src/ControllerLogin.hs 20
-  let mbSk = readData (readCookieValue "sid" :: RqData SessionKey) rq
+  let mbSk = getMbSessKey rq
hunk ./src/ControllerLogin.hs 23
-     Just sk -> do mbSd <- query . GetSession $ sk
-                   return $ maybe Nothing (Just . sesUser) mbSd 
+     Just sk -> do mbSessdata <- query . GetSession $ sk
+                   return $ maybe Nothing (Just . sesUser) mbSessdata
+
hunk ./src/ControllerLogin.hs 30
--- remove this form?
--- loginform = ioMsgToSp . tutlayout [] $ "login"
-
-
-loginaction :: ServerPartT IO Response
-loginaction = withData loginPage
-
-
-
-
hunk ./src/Model.hs 1
-{-# OPTIONS -XPatternSignatures #-}
+{-# OPTIONS -XPatternSignatures -fno-monomorphism-restriction #-}
hunk ./src/Model.hs 28
+loginPage :: UserAuthInfo -> [ServerPartT IO Response]
hunk ./src/Model.hs 33
-            ioMsgToWeb $ tutlayout [] "home" 
-    else msgToWeb "Incorrect password"
+            tutlayoutWeb [] "home" 
+    else tutlayoutWeb [] "badlogin"
hunk ./src/Model.hs 37
+-- logoutPage :: [ServerPartT IO Response]
+logoutPage = [ do
+  withRequest $ \rq -> do
+    performLogout rq
+    tutlayoutWeb [] "home" ]
hunk ./src/Model.hs 47
-  -- msgToWeb $ "UserAuthInfo: " ++ show (user)
-  
--- performLogout = do
-  
+
+
+-- performLogout :: Request -> IO ()
+performLogout rq =
+    let mbSk = getMbSessKey rq
+    in maybe 
+         ( return () )
+         ( update . DelSession )
+         mbSk
+
+getMbSessKey :: Request -> Maybe SessionKey
+getMbSessKey rq = readData rqdata rq
+   where rqdata :: RqData SessionKey
+         rqdata = readCookieValue "sid"
+
hunk ./src/Session.hs 65
--- setSession :: SessionKey -> SessionData -> Update TutorialState ()
--- setSession key u = 
-
-
hunk ./src/Session.hs 71
+delSession :: SessionKey -> Update TutorialState ()
+delSession sk = modSessions $ Sessions . (M.delete sk) . unsession
hunk ./src/Session.hs 78
--- numSessions = proxyQuery $ liftM (M.size . unsession) askSessions
-
hunk ./src/Session.hs 89
-     -- , 'setSession
hunk ./src/Session.hs 91
+     , 'delSession
hunk ./src/View.hs 16
--- renderTut :: [(String,String)] -> String -> IO ( StringTemplate String )
--- renderTut attrs tmpl = withTemplateDir "templates" $ renderDef attrs tmpl
-
-
-
-
-
hunk ./src/View.hs 24
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+tutlayoutWeb attrs contentTmpl = ioMsgToWeb $ tutlayout attrs contentTmpl
+tutlayoutSp attrs contentTmpl = ioMsgToSp $ tutlayout attrs contentTmpl
addfile ./templates/badlogin.st
hunk ./templates/badlogin.st 1
-
+<p>Login error. 
+<br>
+Please doublecheck username and password.</p>
hunk ./templates/menubar.st 14
+           |<a href="/tutorial/actions/logout">logout</a>