Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP

Loading…

Update the dependencies to work with Snap 0.11 #17

Open
wants to merge 2 commits into from

1 participant

@Garriot
  1. Updated dependencies for Snap 0.11
  2. Updated Auth Backends by adding the new fields of AuthUser
  3. Updated version to 0.11
Garriot added some commits
@Garriot Garriot Updated dependencies for Snap 0.11
1. Updated dependencies for Snap 0.11
2. Updated Auth Backends by adding the new fields of AuthUser
18bac01
@Garriot Garriot Updated Snaplet-HDBC for Snap 0.13.
Removed all version limitation to keep up with the latest libraries.
0ca34dd
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Commits on Feb 20, 2013
  1. @Garriot

    Updated dependencies for Snap 0.11

    Garriot authored
    1. Updated dependencies for Snap 0.11
    2. Updated Auth Backends by adding the new fields of AuthUser
Commits on Nov 30, 2013
  1. @Garriot

    Updated Snaplet-HDBC for Snap 0.13.

    Garriot authored
    Removed all version limitation to keep up with the latest libraries.
This page is out of date. Refresh to see the latest.
Showing with 36 additions and 23 deletions.
  1. +17 −17 snaplet-hdbc.cabal
  2. +19 −6 src/Snap/Snaplet/Auth/Backends/Hdbc.hs
View
34 snaplet-hdbc.cabal
@@ -1,5 +1,5 @@
name: snaplet-hdbc
-version: 0.9
+version: 0.13
synopsis: HDBC snaplet for Snap Framework
description: This snaplet consists of two parts: an HDBC abstraction snaplet
and an HDBC authentication backend for Snap's authentication
@@ -28,22 +28,22 @@ Library
Snap.Snaplet.Hdbc.Types
build-depends:
- base >= 4 && < 5,
- bytestring >= 0.9.1 && < 0.10,
- clientsession >= 0.7.3.6 && < 0.8,
- containers >= 0.3 && < 0.6,
- convertible >= 1.0 && < 1.1,
- data-lens >= 2.0.1 && < 2.11,
- data-lens-template >= 2.1 && < 2.2,
- HDBC >= 2.2 && < 2.4,
- MonadCatchIO-transformers >= 0.2.1 && < 0.4,
- mtl >= 2.0 && < 2.2,
- resource-pool-catchio >= 0.2 && < 0.3,
- snap >= 0.9 && < 0.10,
- text >= 0.11 && < 0.12,
- time >= 1.1 && < 1.5,
- transformers >= 0.2 && < 0.4,
- unordered-containers >= 0.1.4 && < 0.3
+ base ,
+ bytestring ,
+ clientsession ,
+ containers ,
+ convertible ,
+ data-lens ,
+ data-lens-template ,
+ HDBC ,
+ MonadCatchIO-transformers ,
+ mtl ,
+ resource-pool-catchio ,
+ snap ,
+ text ,
+ time ,
+ transformers ,
+ unordered-containers
ghc-options: -Wall -fwarn-tabs -funbox-strict-fields
-fno-warn-orphans -fno-warn-unused-do-bind
View
25 src/Snap/Snaplet/Auth/Backends/Hdbc.hs
@@ -10,7 +10,6 @@ import Control.Concurrent.MVar
import Control.Monad.State
import Data.Convertible.Base
import qualified Data.HashMap.Strict as HM
-import Data.Lens.Lazy
import Data.List
import Data.Map (Map)
import qualified Data.Map as DM
@@ -21,7 +20,6 @@ import Snap.Snaplet
import Snap.Snaplet.Auth
import Snap.Snaplet.Hdbc.Types
import Snap.Snaplet.Session
-import Snap.Snaplet.Session.Common
import Web.ClientSession
-- | Initialises this HDBC snaplet. It automatically configures a resource
@@ -30,7 +28,7 @@ import Web.ClientSession
initHdbcAuthManager
:: (ConnSrc s, IConnection c)
=> AuthSettings -- ^ Auth settings
- -> Lens b (Snaplet SessionManager) -- ^ Lens to the session manager
+ -> SnapletLens b SessionManager -- ^ Lens to the session manager
-> s c -- ^ Raw HDBC connection
-> AuthTable -- ^ Authentication table configuration
-> Queries -- ^ Queries to be used for authentication
@@ -69,9 +67,12 @@ data AuthTable
, colId :: String
, colLogin :: String
, colPassword :: String
+ , colEmail :: String
, colActivatedAt :: String
, colSuspendedAt :: String
, colRememberToken :: String
+ , colResetToken :: String
+ , colResetRequestedAt :: String
, colLoginCount :: String
, colFailedLoginCount :: String
, colLockedOutUntil :: String
@@ -90,11 +91,14 @@ defAuthTable
= AuthTable
{ tblName = "users"
, colId = "uid"
- , colLogin = "email"
+ , colLogin = "login"
, colPassword = "password"
+ , colEmail = "email"
, colActivatedAt = "activated_at"
, colSuspendedAt = "suspended_at"
, colRememberToken = "remember_token"
+ , colResetToken = "reset_token"
+ , colResetRequestedAt = "reset_requested_at"
, colLoginCount = "login_count"
, colFailedLoginCount = "failed_login_count"
, colLockedOutUntil = "locked_out_until"
@@ -113,9 +117,12 @@ colLst :: [AuthTable -> String]
colLst =
[ colLogin
, colPassword
+ , colEmail
, colActivatedAt
, colSuspendedAt
, colRememberToken
+ , colResetToken
+ , colResetRequestedAt
, colLoginCount
, colFailedLoginCount
, colLockedOutUntil
@@ -169,9 +176,12 @@ defSaveQuery tbl au = (mkQry uid, mkIdQry, mkVals uid)
mkVals (Just i) = mkVals' ++ [toSql i]
mkVals' = [ toSql $ userLogin au
, toSql $ userPassword au
+ , toSql $ userEmail au
, toSql $ userActivatedAt au
, toSql $ userSuspendedAt au
, toSql $ userRememberToken au
+ , toSql $ userResetToken au
+ , toSql $ userResetRequestedAt au
, toSql $ userLoginCount au
, toSql $ userFailedLoginCount au
, toSql $ userLockedOutUntil au
@@ -209,7 +219,7 @@ instance IAuthBackend HdbcAuthManager where
let (qry, idQry, vals) = saveQuery qs tbl au
withConn st $ prepExec qry vals
if isJust $ userId au
- then return au
+ then return $! Right au
else do
rw <- withConn st $ \conn -> withTransaction conn $ \conn' -> do
stmt' <- prepare conn' idQry
@@ -221,7 +231,7 @@ instance IAuthBackend HdbcAuthManager where
"It might not have been inserted at all."
Just [] -> fail "Something went wrong"
Just (x:_) -> return (fromSql x :: Text)
- return $ au { userId = Just (UserId nid) }
+ return $! Right $ au { userId = Just (UserId nid) }
lookupByUserId mgr@(HdbcAuthManager _ tbl qs) uid = authQuery mgr $
selectQuery qs tbl ByUserId [toSql uid]
@@ -256,9 +266,12 @@ mkUser tbl mp =
in AuthUser
{ userId = rdSql UserId colId
, userLogin = fromSql $ colLU colLogin
+ , userEmail = rdSql id colEmail
, userPassword = rdSql Encrypted colPassword
, userActivatedAt = rdSql id colActivatedAt
, userSuspendedAt = rdSql id colSuspendedAt
+ , userResetToken = rdSql id colResetToken
+ , userResetRequestedAt = rdSql id colResetRequestedAt
, userRememberToken = rdSql id colRememberToken
, userLoginCount = rdInt colLoginCount
, userFailedLoginCount = rdInt colFailedLoginCount
Something went wrong with that request. Please try again.