users-mysql-haskell 0.5.1.0 → 0.5.2.0

raw patch · 2 files changed

+44/−18 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• src/Web/Users/MySQL.hs +43/−17
• users-mysql-haskell.cabal +1/−1

@@ -77,33 +77,47 @@  userByNameSQL :: Query userByNameSQL = -	"SELECT lid, username, password, email, is_active \-	\ FROM login WHERE (username = ? OR email = ?) LIMIT 1;"+    "SELECT lid, username, password, email, is_active \+    \ FROM login WHERE (username = ? OR email = ?) LIMIT 1;"  tokenIdSQL :: Query tokenIdSQL = -	"SELECT lid FROM login_token WHERE token_type = ? \-	\ AND token = ? AND valid_until > NOW() LIMIT 1;"+    "SELECT lid FROM login_token WHERE token_type = ? \+    \ AND token = ? AND valid_until > NOW() LIMIT 1;"  insertTokenSQL :: Query insertTokenSQL =      "INSERT INTO login_token (token, token_type, lid, valid_until)\     \ VALUES (?, ?, ?, timestampadd(SECOND,?,NOW()));" +-- http://stackoverflow.com/questions/3626645/determining-if-mysql-table-index-exists-before-creating+indexExistsSQL :: Query+indexExistsSQL = +    "SELECT EXISTS (SELECT INDEX_NAME FROM INFORMATION_SCHEMA.STATISTICS WHERE\+    \ TABLE_SCHEMA = DATABASE() AND\+    \ TABLE_NAME = ? AND \+    \ INDEX_NAME = ?);"+ instance UserStorageBackend Backend where      type UserId Backend = Int64      initUserBackend (Backend conn) = do         _ <- execute_ conn usersTableSQL-        _ <- execute_ conn createUserNameIndexSQL-        _ <- execute_ conn createEmailIndexSQL+        unlessM (doesIndexExist conn "login" "l_username") $ do+            _ <- execute_ conn createUserNameIndexSQL+            return ()+        unlessM (doesIndexExist conn "login" "l_email") $ do+            _ <- execute_ conn createEmailIndexSQL+            return ()         _ <- execute_ conn userTokenTableSQL-        _ <- execute_ conn createTokenIndexSQL+        unlessM (doesIndexExist conn "login_token" "lt_token") $ do+            _ <- execute_ conn createTokenIndexSQL+            return ()         return ()     destroyUserBackend (Backend conn) = do-        _ <- execute_ conn "drop table login_token;"-        _ <- execute_ conn "drop table login;"+        _ <- execute_ conn "drop table if exists login_token;"+        _ <- execute_ conn "drop table if exists login;"         return ()     housekeepBackend (Backend conn) = do         _ <- execute_ conn "DELETE FROM login_token WHERE valid_until < NOW();"@@ -146,10 +160,10 @@              Just _ -> Just . SessionId <$> createToken b "session" userId sessionTtl     withAuthUser (Backend conn) username authFn action =         do resultSet <- drain $ query conn -								 	  userByNameSQL-									  [MySQLText username-									  ,MySQLText username-									  ]+                                      userByNameSQL+                                      [MySQLText username+                                      ,MySQLText username+                                      ]            case resultSet of              [ MySQLInt64 userId, MySQLText name, MySQLText password, MySQLText email, MySQLInt8 is_active ] : _                 -> do let user = convertUserTuple (name, PasswordHash password, email, is_active /= 0)@@ -271,7 +285,7 @@ doesUsernameAlreadyExist (Backend conn) newUser origUser = do     when (u_name newUser /= u_name origUser) $ do         [MySQLInt64 counter] : _ <- liftIO $ drain $ query conn -														   "SELECT COUNT(lid) FROM login where username = ?;" +                                                           "SELECT COUNT(lid) FROM login where username = ?;"                                                             [MySQLText $ u_name newUser]         when (counter /= 0) $ do             throwE UsernameAlreadyExists@@ -280,7 +294,7 @@ doesEmailAlreadyExist (Backend conn) newUser origUser = do     when (u_email newUser /= u_email origUser) $ do         [MySQLInt64 counter] : _ <- liftIO $ drain $ query conn -														   "SELECT COUNT(lid) FROM login where lower(email) = lower(?);" +                                                           "SELECT COUNT(lid) FROM login where lower(email) = lower(?);"                                                             [MySQLText $ u_email newUser]         when (counter /= 0) $ do             throwE EmailAlreadyExists@@ -313,7 +327,7 @@ createToken (Backend conn) tokenType userId timeToLive = do     tok <- Text.pack . UUID.toString <$> UUID.nextRandom     _ <- execute conn -				 insertTokenSQL+                 insertTokenSQL                  [MySQLText   $ tok                   ,MySQLText   $ Text.pack tokenType                   ,MySQLInt64  $ userId @@ -327,7 +341,7 @@       Nothing -> return Nothing       Just _  ->           do resultSet <- drain $ query conn -										tokenIdSQL+                                        tokenIdSQL                                         [MySQLText $ Text.pack tokenType                                         ,MySQLText $ token                                         ]@@ -359,6 +373,18 @@                                ,MySQLText   $ token                                ]              return ()++doesIndexExist :: MySQLConn -> Text.Text -> Text.Text -> IO Bool+doesIndexExist conn tableName indexName = do+    [MySQLInt64 is_active] : _ <- drain $ query conn +                                                indexExistsSQL+                                                [MySQLText tableName+                                                ,MySQLText indexName+                                                ]+    return (is_active /= 0)++unlessM :: Monad m => m Bool -> m () -> m ()+unlessM mbool action = mbool >>= flip unless action  convertTtl :: NominalDiffTime -> Int convertTtl = round

@@ -1,5 +1,5 @@ name:                users-mysql-haskell-version:             0.5.1.0+version:             0.5.2.0 synopsis:            A mysql-haskell backend for the users library. description:         A mysql-haskell backend for the users library. license:             BSD3