Permalink
Browse files

Upgrade to the new exceptionless auth api

  • Loading branch information...
1 parent 460f452 commit 70318a6158fef3f8b54293badeb4c6978c33c60a @mightybyte committed Oct 2, 2012
Showing with 18 additions and 18 deletions.
  1. +3 −2 snaplet-postgresql-simple.cabal
  2. +15 −16 src/Snap/Snaplet/Auth/Backends/PostgresqlSimple.hs
@@ -1,5 +1,5 @@
name: snaplet-postgresql-simple
-version: 0.2.1
+version: 0.3
synopsis: postgresql-simple snaplet for the Snap Framework
description: This snaplet contains support for using the Postgresql
database with a Snap Framework application via the
@@ -39,11 +39,12 @@ Library
bytestring >= 0.9.1 && < 0.10,
clientsession >= 0.7.2 && < 0.9,
configurator >= 0.2 && < 0.3,
+ errors >= 1.3 && < 1.4,
MonadCatchIO-transformers >= 0.3 && < 0.4,
mtl >= 2 && < 3,
postgresql-simple >= 0.2 && < 0.3,
resource-pool-catchio >= 0.2 && < 0.3,
- snap >= 0.9 && < 0.11,
+ snap >= 0.10 && < 0.11,
text >= 0.11 && < 0.12,
transformers >= 0.2 && < 0.4,
unordered-containers >= 0.2 && < 0.3
@@ -35,12 +35,14 @@ module Snap.Snaplet.Auth.Backends.PostgresqlSimple
) where
------------------------------------------------------------------------------
+import Prelude hiding (catch)
+import Control.Error
+import Control.Exception (SomeException, catch)
import qualified Data.Configurator as C
import qualified Data.HashMap.Lazy as HM
import qualified Data.Text as T
import Data.Text (Text)
import qualified Data.Text.Encoding as T
-import Data.Maybe
import Data.Pool
import qualified Database.PostgreSQL.Simple as P
import qualified Database.PostgreSQL.Simple.ToField as P
@@ -259,7 +261,8 @@ saveQuery at u@AuthUser{..} = maybe insertQuery updateQuery userId
, T.intercalate "," cols
, ") VALUES ("
, T.intercalate "," vals
- , ")"
+ , ") RETURNING "
+ , T.intercalate "," (map (fst . ($at) . fst) $ tail colDef)
]
, params)
qval f = fst (f at) `T.append` " = ?"
@@ -270,33 +273,29 @@ saveQuery at u@AuthUser{..} = maybe insertQuery updateQuery userId
, T.intercalate "," (map (qval . fst) $ tail colDef)
, " WHERE "
, fst (colId at)
- , " = ?"
+ , " = ? RETURNING "
+ , T.intercalate "," (map (fst . ($at) . fst) $ tail colDef)
]
, params ++ [P.toField $ unUid uid])
cols = map (fst . ($at) . fst) $ tail colDef
vals = map (const "?") cols
params = map (($u) . snd) $ tail colDef
+onFailure :: Monad m => SomeException -> m (Either AuthFailure a)
+onFailure e = return $ Left $ AuthError $ show e
+
------------------------------------------------------------------------------
-- |
instance IAuthBackend PostgresAuthManager where
save PostgresAuthManager{..} u@AuthUser{..} = do
let (qstr, params) = saveQuery pamTable u
let q = Query $ T.encodeUtf8 qstr
- withResource pamConnPool $ \conn -> do
- P.begin conn
- P.execute conn q params
- let q2 = Query $ T.encodeUtf8 $ T.concat
- [ "select * from "
- , tblName pamTable
- , " where "
- , fst (colLogin pamTable)
- , " = ?"
- ]
- res <- P.query conn q2 [userLogin]
- P.commit conn
- return $ fromMaybe u $ listToMaybe res
+ let action = withResource pamConnPool $ \conn -> do
+ res <- P.query conn q params
+ return $ Right $ fromMaybe u $ listToMaybe res
+ catch action onFailure
+
lookupByUserId PostgresAuthManager{..} uid = do
let q = Query $ T.encodeUtf8 $ T.concat

0 comments on commit 70318a6

Please sign in to comment.