users-postgresql-simple 0.3.0.0 → 0.4.0.0

raw patch · 2 files changed

+25/−14 lines, 2 filesdep ~usersPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: users

API changes (from Hackage documentation)

Files

• src/Web/Users/Postgresql.hs +23/−12
• users-postgresql-simple.cabal +2/−2

@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TypeFamilies #-}@@ -7,7 +8,6 @@  import Web.Users.Types -import Control.Applicative ((<$>)) import Control.Monad #if MIN_VERSION_mtl(2,2,0) import Control.Monad.Except@@ -141,32 +141,38 @@     createUser conn user =         case u_password user of           PasswordHash p ->-              do [(Only counter)] <--                     query conn [sql|SELECT COUNT(lid) FROM login WHERE username = ? OR email = ?;|] (u_name user, u_email user)-                 if (counter :: Int64) /= 0-                 then return $ Left UsernameOrEmailAlreadyTaken-                 else do [(Only userId)] <--                             query conn [sql|INSERT INTO login (username, password, email, is_active, more) VALUES (?, ?, ?, ?, ?) RETURNING lid|]-                                   (u_name user, p, u_email user, u_active user, toJSON $ u_more user)-                         return $ Right userId+              do ([(Only emailCounter)], [(Only nameCounter)]) <- (,) <$>+                     query conn [sql|SELECT COUNT(lid) FROM login WHERE email = ? LIMIT 1;|] (Only $ u_email user)+                     <*> query conn [sql|SELECT COUNT(lid) FROM login WHERE username = ? LIMIT 1;|] (Only $ u_name user)+                 let both f (x, y) = (f x, f y)+                     bothCount = both (== 1) (emailCounter :: Int64, nameCounter :: Int64)+                 case bothCount of+                      (True, True)   -> return $ Left UsernameAndEmailAlreadyTaken+                      (True, False)  -> return $ Left EmailAlreadyTaken+                      (False, True)  -> return $ Left UsernameAlreadyTaken+                      (False, False) ->+                        do [(Only userId)] <-+                               query conn [sql|INSERT INTO login (username, password, email, is_active, more) VALUES (?, ?, ?, ?, ?) RETURNING lid|]+                                     (u_name user, p, u_email user, u_active user, toJSON $ u_more user)+                           return $ Right userId           _ ->               return $ Left InvalidPassword     updateUser conn userId updateFun =         do mUser <- getUserById conn userId            case mUser of              Nothing ->-                 return $ Left UserDoesntExit+                 return $ Left UserDoesntExist              Just origUser ->                  runErrorT $                  do let newUser = updateFun origUser                     when (u_name newUser /= u_name origUser) $                          do [(Only counter)] <-                                 liftIO $ query conn [sql|SELECT COUNT(lid) FROM login WHERE username = ?;|] (Only $ u_name newUser)-                            when ((counter :: Int64) /= 0) $ throwError UsernameOrEmailAlreadyExists+                            when ((counter :: Int64) /= 0) $ throwError UsernameAlreadyExists                     when (u_email newUser /= u_email origUser) $                          do [(Only counter)] <-                                 liftIO $ query conn [sql|SELECT COUNT(lid) FROM login WHERE email = ?;|] (Only $ u_email newUser)-                            when ((counter :: Int64) /= 0) $ throwError UsernameOrEmailAlreadyExists+                            when ((counter :: Int64) /= 0) $ throwError EmailAlreadyExists                     liftIO $                        do _ <-                               execute conn [sql|UPDATE login SET username = ?, email = ?, is_active = ?, more = ? WHERE lid = ?;|]@@ -184,6 +190,11 @@     authUser conn username password sessionTtl =         withAuthUser conn username (\(user :: User Value) -> verifyPassword password $ u_password user) $ \userId ->            SessionId <$> createToken conn "session" userId sessionTtl+    createSession conn userId sessionTtl =+        do mUser <- getUserById conn userId+           case (mUser :: Maybe (User Value)) of+             Nothing -> return Nothing+             Just _ -> Just . SessionId <$> createToken conn "session" userId sessionTtl     withAuthUser conn username authFn action =         do resultSet <- query conn [sql|SELECT lid, username, password, email, is_active, more FROM login WHERE (username = ? OR email = ?) LIMIT 1;|] (username, username)            case resultSet of

@@ -1,5 +1,5 @@ name:                users-postgresql-simple-version:             0.3.0.0+version:             0.4.0.0 synopsis:            A PostgreSQL backend for the users package description:         This library is a backend driver using <http://hackage.haskell.org/package/postgresql-simple postgresql-simple> for                      <http://hackage.haskell.org/package/users the "users" library>.@@ -33,7 +33,7 @@   exposed-modules:     Web.Users.Postgresql   build-depends:                        base >=4.6 && <5,-                       users >=0.3.0.0,+                       users >=0.4.0.0,                        postgresql-simple >=0.4,                        aeson >=0.7,                        text >=1.2,