Permalink
Browse files

Implement some missing functionality

  • Loading branch information...
ozataman committed Sep 15, 2011
1 parent bf7e64a commit 6c2f2432a9d2a5cb48dd653059acb3307e8a1f88
Showing with 12 additions and 6 deletions.
  1. +4 −1 src/Snap/Snaplet/Auth.hs
  2. +8 −5 src/Snap/Snaplet/Auth/Handlers.hs
View
@@ -204,7 +204,10 @@ markAuthSuccess u = do
>>= resetFailCtr >>= liftIO . save r
where
incLoginCtr u' = return $ u' { userLoginCount = userLoginCount u' + 1 }
- updateIp u' = fail "updateIP not defined in markAuthSuccess"
+ updateIp u' = do
+ ip <- rqRemoteAddr `fmap` getRequest
+ return $ u' { userLastLoginIp = userCurrentLoginIp u'
+ , userCurrentLoginIp = Just ip }
updateLoginTS u' = do
now <- liftIO getCurrentTime
return $
@@ -22,6 +22,7 @@ import Control.Monad.CatchIO (throw)
import Control.Monad.State
import Crypto.PasswordStore
import Data.ByteString (ByteString)
+import Data.Lens.Lazy
import Data.Text.Encoding (decodeUtf8)
import Data.Text (Text)
import Data.Time
@@ -94,11 +95,13 @@ logoutUser target = logout >> target
-- This function has no DB cost - only checks to see if a user_id is present in
-- the current session.
requireUser
- :: Handler b (AuthManager b) a
+ :: Lens b (Snaplet (AuthManager b))
+ -- Lens reference to an "AuthManager"
+ -> Handler b v a
-- ^ Do this if no authenticated user is present.
- -> Handler b (AuthManager b) a
+ -> Handler b v a
-- ^ Do this if an authenticated user is present.
- -> Handler b (AuthManager b) a
-requireUser bad good = do
- loggedIn <- isLoggedIn
+ -> Handler b v a
+requireUser auth bad good = do
+ loggedIn <- withTop auth isLoggedIn
if loggedIn then good else bad

0 comments on commit 6c2f243

Please sign in to comment.