diff --git a/project_template/barebones/foo.cabal b/project_template/barebones/foo.cabal --- a/project_template/barebones/foo.cabal +++ b/project_template/barebones/foo.cabal @@ -17,7 +17,7 @@ Build-depends: base >= 4 && < 5, bytestring >= 0.9.1 && < 0.10, - MonadCatchIO-transformers >= 0.2.1 && < 0.3, + MonadCatchIO-transformers >= 0.2.1 && < 0.4, mtl >= 2 && < 3, snap-core == 0.8.*, snap-server == 0.8.* diff --git a/project_template/default/foo.cabal b/project_template/default/foo.cabal --- a/project_template/default/foo.cabal +++ b/project_template/default/foo.cabal @@ -21,10 +21,10 @@ Build-depends: base >= 4 && < 5, bytestring >= 0.9.1 && < 0.10, - data-lens >= 2.0.1 && < 2.1, + data-lens >= 2.0.1 && < 2.11, data-lens-template >= 2.1 && < 2.2, heist >= 0.8 && < 0.9, - MonadCatchIO-transformers >= 0.2.1 && < 0.3, + MonadCatchIO-transformers >= 0.2.1 && < 0.4, mtl >= 2 && < 3, snap == 0.8.*, snap-core == 0.8.*, diff --git a/project_template/tutorial/foo.cabal b/project_template/tutorial/foo.cabal --- a/project_template/tutorial/foo.cabal +++ b/project_template/tutorial/foo.cabal @@ -17,7 +17,7 @@ Build-depends: base >= 4 && < 5, bytestring >= 0.9.1 && < 0.10, - MonadCatchIO-transformers >= 0.2.1 && < 0.3, + MonadCatchIO-transformers >= 0.2.1 && < 0.4, mtl >= 2 && < 3, snap == 0.8.*, snap-core == 0.8.*, diff --git a/snap.cabal b/snap.cabal --- a/snap.cabal +++ b/snap.cabal @@ -1,5 +1,5 @@ name: snap -version: 0.8.0.2 +version: 0.8.1 synopsis: Snap: A Haskell Web Framework: project starter executable and glue code library description: Snap Framework project starter executable and glue code library license: BSD3 @@ -130,7 +130,7 @@ unix >= 2.2.0.0 && < 2.6 build-depends: - MonadCatchIO-transformers >= 0.2 && < 0.3, + MonadCatchIO-transformers >= 0.2 && < 0.4, aeson >= 0.6 && < 0.7, attoparsec >= 0.10 && < 0.11, base >= 4 && < 5, @@ -141,23 +141,23 @@ containers >= 0.3 && < 0.5, directory >= 1.0 && < 1.2, directory-tree >= 0.10 && < 0.11, - data-lens >= 2.0.1 && < 2.1, + data-lens >= 2.0.1 && < 2.11, data-lens-template >= 2.1 && < 2.2, filepath >= 1.1 && < 1.4, hashable >= 1.1 && < 1.2, heist >= 0.7 && < 0.9, logict >= 0.4.2 && < 0.6, - mtl > 2.0 && < 2.1, + mtl > 2.0 && < 2.2, mwc-random >= 0.8 && < 0.13, pwstore-fast >= 2.2 && < 2.3, - snap-core >= 0.8 && < 0.9, - snap-server >= 0.8 && < 0.9, + snap-core >= 0.8.1 && < 0.9, + snap-server >= 0.8.1 && < 0.9, stm >= 2.2 && < 2.4, syb >= 0.1 && < 0.4, template-haskell >= 2.2 && < 2.8, text >= 0.11 && < 0.12, time >= 1.1 && < 1.5, - transformers >= 0.2 && < 0.3, + transformers >= 0.2 && < 0.4, unordered-containers >= 0.1.4 && < 0.3, utf8-string >= 0.3 && < 0.4, vector >= 0.7.1 && < 0.10, diff --git a/src/Snap/Snaplet/Auth.hs b/src/Snap/Snaplet/Auth.hs --- a/src/Snap/Snaplet/Auth.hs +++ b/src/Snap/Snaplet/Auth.hs @@ -47,6 +47,7 @@ , Role(..) -- * Other Utilities + , authSettingsFromConfig , withBackend , encryptPassword , checkPassword diff --git a/src/Snap/Snaplet/Auth/AuthManager.hs b/src/Snap/Snaplet/Auth/AuthManager.hs --- a/src/Snap/Snaplet/Auth/AuthManager.hs +++ b/src/Snap/Snaplet/Auth/AuthManager.hs @@ -5,6 +5,7 @@ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} module Snap.Snaplet.Auth.AuthManager ( -- * AuthManager Datatype @@ -26,7 +27,6 @@ import Snap.Snaplet import Snap.Snaplet.Session -import Snap.Snaplet.Session.Common import Snap.Snaplet.Auth.Types @@ -97,4 +97,11 @@ , randomNumberGenerator :: RNG -- ^ Random number generator } + +instance IAuthBackend (AuthManager b) where + save AuthManager{..} u = save backend u + lookupByUserId AuthManager{..} u = lookupByUserId backend u + lookupByLogin AuthManager{..} u = lookupByLogin backend u + lookupByRememberToken AuthManager{..} u = lookupByRememberToken backend u + destroy AuthManager{..} u = destroy backend u diff --git a/src/Snap/Snaplet/Auth/Backends/JsonFile.hs b/src/Snap/Snaplet/Auth/Backends/JsonFile.hs --- a/src/Snap/Snaplet/Auth/Backends/JsonFile.hs +++ b/src/Snap/Snaplet/Auth/Backends/JsonFile.hs @@ -32,7 +32,6 @@ import Snap.Snaplet.Auth.Types import Snap.Snaplet.Auth.AuthManager import Snap.Snaplet.Session -import Snap.Snaplet.Session.Common diff --git a/src/Snap/Snaplet/Auth/Handlers.hs b/src/Snap/Snaplet/Auth/Handlers.hs --- a/src/Snap/Snaplet/Auth/Handlers.hs +++ b/src/Snap/Snaplet/Auth/Handlers.hs @@ -29,8 +29,6 @@ import Snap.Snaplet.Auth.AuthManager import Snap.Snaplet.Auth.Types import Snap.Snaplet.Session -import Snap.Snaplet.Session.Common -import Snap.Snaplet.Session.SecureCookie ------------------------------------------------------------------------------ diff --git a/src/Snap/Snaplet/Auth/Types.hs b/src/Snap/Snaplet/Auth/Types.hs --- a/src/Snap/Snaplet/Auth/Types.hs +++ b/src/Snap/Snaplet/Auth/Types.hs @@ -7,17 +7,21 @@ ------------------------------------------------------------------------------ import Control.Applicative +import Control.Arrow import Control.Monad.CatchIO +import Control.Monad.Trans import Control.Monad.Trans.Error import Crypto.PasswordStore import Data.Aeson import Data.ByteString (ByteString) +import qualified Data.Configurator as C import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HM import Data.Hashable (Hashable) import Data.Time import Data.Text (Text) import Data.Typeable +import Snap.Snaplet ------------------------------------------------------------------------------ @@ -195,6 +199,35 @@ , asLockout = Nothing , asSiteKey = "site_key.txt" } + + +------------------------------------------------------------------------------ +-- | Function to get auth settings from a config file. This function can be +-- used by the authors of auth snaplet backends in the initializer to let the +-- user configure the auth snaplet from a config file. All options are +-- optional and default to what's in defAuthSettings if not supplied. +-- Here's what the default options would look like in the config file: +-- +-- > minPasswordLen = 8 +-- > rememberCookie = "_remember" +-- > rememberPeriod = 1209600 # 2 weeks +-- > lockout = [5, 86400] # 5 attempts locks you out for 86400 seconds +-- > siteKey = "site_key.txt" +authSettingsFromConfig :: Initializer b v AuthSettings +authSettingsFromConfig = do + config <- getSnapletUserConfig + minPasswordLen <- liftIO $ C.lookup config "minPasswordLen" + let pw = maybe id (\x s -> s { asMinPasswdLen = x }) minPasswordLen + rememberCookie <- liftIO $ C.lookup config "rememberCookie" + let rc = maybe id (\x s -> s { asRememberCookieName = x }) rememberCookie + rememberPeriod <- liftIO $ C.lookup config "rememberPeriod" + let rp = maybe id (\x s -> s { asRememberPeriod = Just x }) rememberPeriod + lockout <- liftIO $ C.lookup config "lockout" + let lo = maybe id (\x s -> s { asLockout = Just (second fromInteger x) }) + lockout + siteKey <- liftIO $ C.lookup config "siteKey" + let sk = maybe id (\x s -> s { asSiteKey = x }) siteKey + return $ (pw . rc . rp . lo . sk) defAuthSettings ------------------------------------------------------------------------------ diff --git a/src/Snap/Snaplet/Internal/Initializer.hs b/src/Snap/Snaplet/Internal/Initializer.hs --- a/src/Snap/Snaplet/Internal/Initializer.hs +++ b/src/Snap/Snaplet/Internal/Initializer.hs @@ -194,10 +194,11 @@ then setL scId (Just snapletId) c else c sid <- iGets (T.unpack . fromJust . _scId . _curConfig) topLevel <- iGets _isTopLevel - unless topLevel $ modifyCfg $ \c -> setL scFilePath - (_scFilePath c "snaplets" sid) c + unless topLevel $ do + modifyCfg $ modL scUserConfig (subconfig (T.pack sid)) + modifyCfg $ \c -> setL scFilePath + (_scFilePath c "snaplets" sid) c iModify (setL isTopLevel False) - modifyCfg $ modL scUserConfig (subconfig (T.pack sid)) modifyCfg $ setL scDescription desc cfg <- iGets _curConfig printInfo $ T.pack $ concat @@ -211,7 +212,8 @@ -- up but before snaplet.cfg is read. setupFilesystem getSnapletDataDir (_scFilePath cfg) - liftIO $ addToConfig [Optional (_scFilePath cfg "snaplet.cfg")] + let configLocation = _scFilePath cfg "snaplet.cfg" + liftIO $ addToConfig [Optional configLocation] (_scUserConfig cfg) mkSnaplet m @@ -454,9 +456,8 @@ -> FilePath -> IO (Either Text (Snaplet b, InitializerState b)) runInitializer' mvar b@(Initializer i) cwd = do - userConfig <- load [Optional "snaplet.cfg"] let builtinHandlers = [("/admin/reload", reloadSite)] - let cfg = SnapletConfig [] cwd Nothing "" userConfig [] Nothing + let cfg = SnapletConfig [] cwd Nothing "" empty [] Nothing (mkReloader cwd mvar b) logRef <- newIORef "" cleanupRef <- newIORef (return ()) diff --git a/src/Snap/Snaplet/Session.hs b/src/Snap/Snaplet/Session.hs --- a/src/Snap/Snaplet/Session.hs +++ b/src/Snap/Snaplet/Session.hs @@ -1,5 +1,6 @@ module Snap.Snaplet.Session - ( SessionManager + ( SessionManager(..) + , ISessionManager(..) , withSession , commitSession , setInSession @@ -9,6 +10,9 @@ , sessionToList , resetSession , touchSession + + , module Snap.Snaplet.Session.Common + , module Snap.Snaplet.Session.SecureCookie ) where ------------------------------------------------------------------------------ @@ -18,6 +22,8 @@ import Snap.Core ------------------------------------------------------------------------------ import Snap.Snaplet +import Snap.Snaplet.Session.Common +import Snap.Snaplet.Session.SecureCookie import Snap.Snaplet.Session.SessionManager ( SessionManager(..), ISessionManager(..) ) import qualified Snap.Snaplet.Session.SessionManager as SM diff --git a/src/Snap/Snaplet/Session/Backends/CookieSession.hs b/src/Snap/Snaplet/Session/Backends/CookieSession.hs --- a/src/Snap/Snaplet/Session/Backends/CookieSession.hs +++ b/src/Snap/Snaplet/Session/Backends/CookieSession.hs @@ -22,9 +22,7 @@ import Web.ClientSession ------------------------------------------------------------------------------ import Snap.Snaplet -import Snap.Snaplet.Session.Common -import Snap.Snaplet.Session.SessionManager -import Snap.Snaplet.Session.SecureCookie +import Snap.Snaplet.Session ------------------------------------------------------------------------------ diff --git a/test/snap-testsuite.cabal b/test/snap-testsuite.cabal --- a/test/snap-testsuite.cabal +++ b/test/snap-testsuite.cabal @@ -10,13 +10,13 @@ build-depends: Glob >= 0.5 && < 0.8, HUnit >= 1.2 && < 2, - MonadCatchIO-transformers >= 0.2 && < 0.3, + MonadCatchIO-transformers >= 0.2 && < 0.4, QuickCheck >= 2.3.0.2, attoparsec >= 0.10 && <0.11, base >= 4 && < 5, bytestring >= 0.9 && < 0.10, containers >= 0.3, - data-lens >= 2.0.1 && < 2.1, + data-lens >= 2.0.1 && < 2.11, data-lens-template >= 2.1.1 && < 2.2, directory, directory-tree >= 0.10 && < 0.11, @@ -25,11 +25,11 @@ http-enumerator >= 0.7.1.7 && < 0.8, mtl >= 2, process == 1.*, - snap-core >= 0.8 && < 0.9, - snap-server >= 0.8 && < 0.9, - test-framework >= 0.5 && < 0.6, - test-framework-hunit >= 0.2.5 && < 0.3, - test-framework-quickcheck2 >= 0.2.6 && < 0.3, + snap-core >= 0.8.1 && < 0.9, + snap-server >= 0.8.1 && < 0.9, + test-framework >= 0.6 && <0.7, + test-framework-hunit >= 0.2.7 && <0.3, + test-framework-quickcheck2 >= 0.2.12.1 && <0.3, text >= 0.11 && < 0.12, transformers >= 0.2, unix >= 2.2.0.0 && < 2.6, @@ -64,15 +64,15 @@ main-is: AppMain.hs build-depends: - MonadCatchIO-transformers >= 0.2 && < 0.3, - attoparsec >= 0.10 && <0.11, + MonadCatchIO-transformers >= 0.2 && < 0.4, + attoparsec >= 0.10 && < 0.11, base >= 4 && < 5, bytestring >= 0.9 && < 0.10, cereal >= 0.3, - clientsession >= 0.7.3.6 && <0.8, + clientsession >= 0.7.3.6 && < 0.8, configurator >= 0.1 && < 0.3, containers >= 0.3, - data-lens >= 2.0.1 && < 2.1, + data-lens >= 2.0.1 && < 2.11, data-lens-template >= 2.1.1 && < 2.2, directory, directory-tree >= 0.10 && < 0.11, @@ -82,8 +82,8 @@ mtl >= 2, mwc-random >= 0.8, process == 1.*, - snap-core >= 0.8 && < 0.9, - snap-server >= 0.8 && < 0.9, + snap-core >= 0.8.1 && < 0.9, + snap-server >= 0.8.1 && < 0.9, syb >= 0.1, time >= 1.1, text >= 0.11 && < 0.12, @@ -120,12 +120,12 @@ main-is: NestTest.hs build-depends: - MonadCatchIO-transformers >= 0.2 && < 0.3, - attoparsec >= 0.10 && <0.11, + MonadCatchIO-transformers >= 0.2 && < 0.4, + attoparsec >= 0.10 && < 0.11, base >= 4 && < 5, bytestring >= 0.9 && < 0.10, containers >= 0.3, - data-lens >= 2.0.1 && < 2.1, + data-lens >= 2.0.1 && < 2.11, data-lens-template >= 2.1 && < 2.2, directory, directory-tree >= 0.10 && < 0.11, @@ -133,8 +133,8 @@ heist >= 0.7 && < 0.9, mtl >= 2, process == 1.*, - snap-core >= 0.8 && < 0.9, - snap-server >= 0.8 && < 0.9, + snap-core >= 0.8.1 && < 0.9, + snap-server >= 0.8.1 && < 0.9, text >= 0.11 && < 0.12, transformers >= 0.2, utf8-string >= 0.3 && < 0.4, diff --git a/test/suite/Blackbox/App.hs b/test/suite/Blackbox/App.hs --- a/test/suite/Blackbox/App.hs +++ b/test/suite/Blackbox/App.hs @@ -28,7 +28,7 @@ import Blackbox.FooSnaplet import Blackbox.EmbeddedSnaplet import Blackbox.Types -import Snap.Snaplet.Session +import Snap.Snaplet.Session hiding (lookup) import Snap.Snaplet.Session.Backends.CookieSession