users-persistent 0.5.0.0 → 0.5.0.1

raw patch · 2 files changed

+15/−5 lines, 2 files

Files

• src/Web/Users/Persistent.hs +14/−4
• users-persistent.cabal +1/−1

@@ -226,7 +226,7 @@ createToken conn tokenType userId timeToLive =     runPersistent conn $     do tok <- liftM (T.pack . UUID.toString) $ liftIO $ UUID.nextRandom-       now <- liftIO $ getCurrentTime+       now <- liftIO getCurrentTime        _ <- insert $ LoginToken tok (T.pack tokenType) now (timeToLive `addUTCTime` now) userId        return tok @@ -245,9 +245,19 @@     case UUID.fromString (T.unpack token) of       Nothing -> return ()       Just _ ->-          do now <- liftIO $ getCurrentTime-             updateWhere [LoginTokenToken ==. token, LoginTokenTokenType ==. (T.pack tokenType)] [LoginTokenValidUntil =. (timeToLive `addUTCTime` now)]-             return ()+        do let selC = [LoginTokenTokenType ==. T.pack tokenType, LoginTokenToken ==. token]+           m <-+             selectFirst selC [Desc LoginTokenValidUntil]+           case m of+             Nothing -> return ()+             Just t ->+               do let validUntil =+                        loginTokenValidUntil (entityVal t)+                  now <- liftIO getCurrentTime+                  let extendedValid = timeToLive `addUTCTime` now+                  when (extendedValid > validUntil) $+                      updateWhere selC [LoginTokenValidUntil =. extendedValid]+                  return ()  getTokenOwner :: Persistent -> String -> T.Text -> IO (Maybe LoginId) getTokenOwner conn tokenType token =

@@ -1,5 +1,5 @@ name:                users-persistent-version:             0.5.0.0+version:             0.5.0.1 synopsis:            A persistent backend for the users package description:         This library is a backend driver using <http://hackage.haskell.org/package/persistent persistent> for                      <http://hackage.haskell.org/package/users the "users" library>.