snap 1.0.0.2 → 1.1.0.0

raw patch · 4 files changed

+44/−8 lines, 4 filesdep −Globdep ~aesondep ~asyncdep ~lensPVP ok

version bump matches the API change (PVP)

Dependencies removed: Glob

Dependency ranges changed: aeson, async, lens

API changes (from Hackage documentation)

Files

• snap.cabal +4/−5
• src/Snap/Snaplet/Auth.hs +1/−1
• src/Snap/Snaplet/Auth/AuthManager.hs +2/−1
• src/Snap/Snaplet/Auth/Backends/JsonFile.hs +37/−1

@@ -1,5 +1,5 @@ name:           snap-version:        1.0.0.2+version:        1.1.0.0 synopsis:       Top-level package for the Snap Web Framework description:     This is the top-level package for the official Snap Framework libraries.@@ -103,7 +103,7 @@     Snap.Snaplet.Session.SecureCookie    build-depends:-    aeson                     >= 0.6      && < 1.2,+    aeson                     >= 0.6      && < 1.3,     attoparsec                >= 0.10     && < 0.14,     base                      >= 4        && < 4.11,     bytestring                >= 0.9.1    && < 0.11,@@ -131,7 +131,7 @@     snap-server               >= 1.0      && < 1.1,     stm                       >= 2.2      && < 2.5,     text                      >= 0.11     && < 1.3,-    time                      >= 1.1      && < 1.7,+    time                      >= 1.1      && < 1.9,     transformers              >= 0.2      && < 0.6,     transformers-base         >= 0.4      && < 0.5,     unordered-containers      >= 0.1.4    && < 0.3,@@ -233,7 +233,6 @@     directory-tree,     dlist,     filepath,-    Glob                       >= 0.7.5    && < 0.9,     hashable,     heist,     http-streams               >= 0.7.1.1  && < 0.9,@@ -245,7 +244,7 @@     mtl,     mwc-random,     pwstore-fast,-    QuickCheck                 >= 2.4.2    && < 2.10,+    QuickCheck                 >= 2.4.2    && < 2.11,     smallcheck                 >= 1.1.1    && < 1.2,     snap-core,     snap-server,

@@ -46,7 +46,7 @@   , Role(..)    -- * Other Utilities-  , authSettingsFromConfig +  , authSettingsFromConfig   , withBackend   , encryptPassword   , checkPassword

@@ -59,6 +59,7 @@   save                  :: r -> AuthUser -> IO (Either AuthFailure AuthUser)   lookupByUserId        :: r -> UserId   -> IO (Maybe AuthUser)   lookupByLogin         :: r -> Text     -> IO (Maybe AuthUser)+  lookupByEmail         :: r -> Text     -> IO (Maybe AuthUser)   lookupByRememberToken :: r -> Text     -> IO (Maybe AuthUser)   destroy               :: r -> AuthUser -> IO () @@ -101,6 +102,6 @@     save AuthManager{..} u = save backend u     lookupByUserId AuthManager{..} u = lookupByUserId backend u     lookupByLogin AuthManager{..} u = lookupByLogin backend u+    lookupByEmail AuthManager{..}  u = lookupByEmail backend u     lookupByRememberToken AuthManager{..} u = lookupByRememberToken backend u     destroy AuthManager{..} u = destroy backend u-

@@ -10,6 +10,7 @@   ) where  +import           Control.Applicative ((<|>)) import           Control.Monad.State import           Control.Concurrent.STM import           Data.Aeson@@ -18,7 +19,8 @@ import qualified Data.ByteString as B import qualified Data.Map as HM import           Data.Map (Map)-import           Data.Maybe (fromJust, isJust)+import           Data.Maybe (fromJust, isJust, listToMaybe)+import           Data.Monoid (mempty) import           Data.Text (Text) import qualified Data.Text as T import           Data.Time@@ -104,6 +106,10 @@   ------------------------------------------------------------------------------+type EmailUserCache = Map Text UserId+++------------------------------------------------------------------------------ type RemTokenUserCache = Map Text UserId  @@ -113,6 +119,7 @@ data UserCache = UserCache {     uidCache    :: UserIdCache          -- ^ the actual datastore   , loginCache  :: LoginUserCache       -- ^ fast lookup for login field+  , emailCache  :: EmailUserCache       -- ^ fast lookup for email field   , tokenCache  :: RemTokenUserCache    -- ^ fast lookup for remember tokens   , uidCounter  :: Int                  -- ^ user id counter }@@ -123,6 +130,7 @@ defUserCache = UserCache {     uidCache   = HM.empty   , loginCache = HM.empty+  , emailCache = HM.empty   , tokenCache = HM.empty   , uidCounter = 0 }@@ -198,6 +206,8 @@             return $! cache {               uidCache   = HM.insert uid' u' $ uidCache cache             , loginCache = HM.insert (userLogin u') uid' $ loginCache cache+            , emailCache = maybe id (\em -> HM.insert em uid') (userEmail u) $+                           emailCache cache             , tokenCache = case userRememberToken u' of                              Nothing -> tokenCache cache                              Just x  -> HM.insert x uid' $ tokenCache cache@@ -216,9 +226,11 @@         Nothing -> return $! Left UserNotFound         Just x -> do           let oldLogin = userLogin x+          let oldEmail = userEmail x           let oldToken = userRememberToken x           let uid      = fromJust $ userId u           let newLogin = userLogin u+          let newEmail = userEmail u           let newToken = userRememberToken u            let lc       = if oldLogin /= userLogin u@@ -227,6 +239,16 @@                                 loginCache cache                            else loginCache cache +          let ec       = if oldEmail /= newEmail+                           then (case (oldEmail, newEmail) of+                                   (Nothing, Nothing) -> id+                                   (Just e,  Nothing) -> HM.delete e+                                   (Nothing, Just e ) -> HM.insert e uid+                                   (Just e,  Just e') -> HM.insert e' uid .+                                                         HM.delete e+                                ) (emailCache cache)+                           else emailCache cache+           let tc       = if oldToken /= newToken && isJust oldToken                            then HM.delete (fromJust oldToken) $ loginCache cache                            else tokenCache cache@@ -240,6 +262,7 @@           let new      = cache {                              uidCache   = HM.insert uid u' $ uidCache cache                            , loginCache = lc+                           , emailCache = ec                            , tokenCache = tc'                          } @@ -273,6 +296,16 @@       f cache = getUid >>= getUser cache         where getUid = HM.lookup login (loginCache cache) +  lookupByEmail mgr email = withCache mgr f+    where+      f cache = getEmail >>= getUser cache+        where getEmail = case HM.lookup email (emailCache cache) of+                      Just u  -> return u+                      Nothing -> (join . fmap userId .+                                  listToMaybe . HM.elems $+                                  HM.filter ((== Just email) . userEmail)+                                  (uidCache  cache))+   lookupByRememberToken mgr token = withCache mgr f     where       f cache = getUid >>= getUser cache@@ -306,6 +339,7 @@   toJSON uc = object     [ "uidCache"   .= uidCache   uc     , "loginCache" .= loginCache uc+    , "emailCache" .= emailCache uc     , "tokenCache" .= tokenCache uc     , "uidCounter" .= uidCounter uc     ]@@ -317,6 +351,8 @@     UserCache       <$> v .: "uidCache"       <*> v .: "loginCache"+      <*> (v .: "emailCache" <|> pure mempty) -- Old versions of users.json do+                                              -- not carry this field       <*> v .: "tokenCache"       <*> v .: "uidCounter"   parseJSON _ = error "Unexpected JSON input"