Skip to content
This repository
Browse code

Added a function to the auth snaplet allowing settings to be loaded f…

…rom a config file.
  • Loading branch information...
commit 277a85769ad1b00205d2d02243619254817331b2 1 parent 712adf5
Doug Beardsley authored April 13, 2012
1  src/Snap/Snaplet/Auth.hs
@@ -47,6 +47,7 @@ module Snap.Snaplet.Auth
47 47
   , Role(..)
48 48
 
49 49
   -- * Other Utilities
  50
+  , authSettingsFromConfig 
50 51
   , withBackend
51 52
   , encryptPassword
52 53
   , checkPassword
29  src/Snap/Snaplet/Auth/Types.hs
@@ -198,6 +198,35 @@ defAuthSettings = AuthSettings {
198 198
 
199 199
 
200 200
 ------------------------------------------------------------------------------
  201
+-- | Function to get auth settings from a config file.  This function can be
  202
+-- used by the authors of auth snaplet backends in the initializer to let the
  203
+-- user configure the auth snaplet from a config file.  All options are
  204
+-- optional and default to what's in defAuthSettings if not supplied.
  205
+-- Here's what the default options would look like in the config file:
  206
+--
  207
+-- > minPasswordLen = 8
  208
+-- > rememberCookie = "_remember"
  209
+-- > rememberPeriod = 1209600 # 2 weeks
  210
+-- > lockout = [5, 86400] # 5 attempts locks you out for 86400 seconds
  211
+-- > siteKey = "site_key.txt"
  212
+authSettingsFromConfig :: Initializer b (AuthManager b) AuthSettings
  213
+authSettingsFromConfig = do
  214
+    config <- getSnapletUserConfig
  215
+    minPasswordLen <- liftIO $ C.lookup config "minPasswordLen"
  216
+    let pw = maybe id (\x s -> s { asMinPasswdLen = x }) minPasswordLen
  217
+    rememberCookie <- liftIO $ C.lookup config "rememberCookie"
  218
+    let rc = maybe id (\x s -> s { asRememberCookieName = x }) rememberCookie
  219
+    rememberPeriod <- liftIO $ C.lookup config "rememberPeriod"
  220
+    let rp = maybe id (\x s -> s { asRememberPeriod = Just x }) rememberPeriod
  221
+    lockout <- liftIO $ C.lookup config "lockout"
  222
+    let lo = maybe id (\x s -> s { asLockout = Just (second fromInteger x) })
  223
+                   lockout
  224
+    siteKey <- liftIO $ C.lookup config "siteKey"
  225
+    let sk = maybe id (\x s -> s { asSiteKey = x }) siteKey
  226
+    return $ (pw . rc . rp . lo . sk) defAuthSettings
  227
+
  228
+
  229
+------------------------------------------------------------------------------
201 230
 data BackendError = DuplicateLogin
202 231
                   | BackendError String
203 232
   deriving (Eq,Show,Read,Typeable)

0 notes on commit 277a857

Please sign in to comment.
Something went wrong with that request. Please try again.