Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Rework built-in splices for the auth snaplet

If you're using the compiled splices from the last release, this will break
your application because the splices have changed names.
  • Loading branch information...
commit da5622ca0ac9334f81dba3c54141782f08417d0d 1 parent d7d8b79
Doug Beardsley mightybyte authored
2  snap.cabal
View
@@ -1,5 +1,5 @@
name: snap
-version: 0.11.1.1
+version: 0.11.2
synopsis: Top-level package for the Snap Web Framework
description:
This is the top-level package for the official Snap Framework libraries.
1  src/Snap/Snaplet.hs
View
@@ -91,6 +91,7 @@ module Snap.Snaplet
, addPostInitHook
, addPostInitHookBase
, printInfo
+ , getRoutes
-- * Routes
-- $routes
54 src/Snap/Snaplet/Auth/SpliceHelpers.hs
View
@@ -11,10 +11,10 @@
-}
module Snap.Snaplet.Auth.SpliceHelpers
- (
- addAuthSplices
+ ( addAuthSplices
, compiledAuthSplices
, userCSplices
+ , userISplices
, ifLoggedIn
, ifLoggedOut
, loggedInUser
@@ -61,6 +61,9 @@ addAuthSplices auth = addSplices
]
+------------------------------------------------------------------------------
+-- | List containing compiled splices for ifLoggedIn, ifLoggedOut, and
+-- loggedInUser.
compiledAuthSplices :: SnapletLens b (AuthManager b)
-> [(Text, SnapletCSplice b)]
compiledAuthSplices auth =
@@ -70,21 +73,44 @@ compiledAuthSplices auth =
]
+------------------------------------------------------------------------------
+-- | Function to generate interpreted splices from an AuthUser.
+userISplices :: Monad m => AuthUser -> [(Text, I.Splice m)]
+userISplices AuthUser{..} =
+ [ ("userId", I.textSplice $ maybe "-" unUid userId)
+ , ("userLogin", I.textSplice userLogin)
+ , ("userEmail", I.textSplice $ fromMaybe "-" userEmail)
+ , ("userActive", I.textSplice $ T.pack $ show $ isNothing userSuspendedAt)
+ , ("userLoginCount", I.textSplice $ T.pack $ show userLoginCount)
+ , ("userFailedCount", I.textSplice $ T.pack $ show userFailedLoginCount)
+ , ("userLoginAt", I.textSplice $ maybe "-" (T.pack . show) userCurrentLoginAt)
+ , ("userLastLoginAt", I.textSplice $ maybe "-" (T.pack . show) userLastLoginAt)
+ , ("userSuspendedAt", I.textSplice $ maybe "-" (T.pack . show) userSuspendedAt)
+ , ("userLoginIP", I.textSplice $ maybe "-" decodeUtf8 userCurrentLoginIp)
+ , ("userLastLoginIP", I.textSplice $ maybe "-" decodeUtf8 userLastLoginIp)
+ , ("userIfActive", ifISplice (isNothing userSuspendedAt))
+ , ("userIfSuspended", ifISplice (isJust userSuspendedAt))
+ ]
+
+
+------------------------------------------------------------------------------
+-- | Compiled splices for AuthUser.
userCSplices :: Monad m => [(Text, C.Promise AuthUser -> C.Splice m)]
userCSplices = (C.pureSplices $ C.textSplices
- [ ("login", userLogin)
- , ("email", maybe "-" id . userEmail)
- , ("active", T.pack . show . isNothing . userSuspendedAt)
- , ("loginCount", T.pack . show . userLoginCount)
- , ("failedCount", T.pack . show . userFailedLoginCount)
- , ("loginAt", maybe "-" (T.pack . show) . userCurrentLoginAt)
- , ("lastLoginAt", maybe "-" (T.pack . show) . userLastLoginAt)
- , ("suspendedAt", maybe "-" (T.pack . show) . userSuspendedAt)
- , ("loginIP", maybe "-" decodeUtf8 . userCurrentLoginIp)
- , ("lastLoginIP", maybe "-" decodeUtf8 . userLastLoginIp)
+ [ ("userId", maybe "-" unUid . userId)
+ , ("userLogin", userLogin)
+ , ("userEmail", fromMaybe "-" . userEmail)
+ , ("userActive", T.pack . show . isNothing . userSuspendedAt)
+ , ("userLoginCount", T.pack . show . userLoginCount)
+ , ("userFailedCount", T.pack . show . userFailedLoginCount)
+ , ("userLoginAt", maybe "-" (T.pack . show) . userCurrentLoginAt)
+ , ("userLastLoginAt", maybe "-" (T.pack . show) . userLastLoginAt)
+ , ("userSuspendedAt", maybe "-" (T.pack . show) . userSuspendedAt)
+ , ("userLoginIP", maybe "-" decodeUtf8 . userCurrentLoginIp)
+ , ("userLastLoginIP", maybe "-" decodeUtf8 . userLastLoginIp)
]) ++
- [ ("ifActive", ifCSplice (isNothing . userSuspendedAt))
- , ("ifSuspended", ifCSplice (isJust . userSuspendedAt))
+ [ ("userIfActive", ifCSplice (isNothing . userSuspendedAt))
+ , ("userIfSuspended", ifCSplice (isJust . userSuspendedAt))
]
8 src/Snap/Snaplet/Internal/Initializer.hs
View
@@ -21,6 +21,7 @@ module Snap.Snaplet.Internal.Initializer
, serveSnaplet
, loadAppConfig
, printInfo
+ , getRoutes
) where
import Prelude hiding (catch)
@@ -78,6 +79,13 @@ iGets f = Initializer $ do
------------------------------------------------------------------------------
+-- | Lets you retrieve the list of routes currently set up by an Initializer.
+-- This can be useful in debugging.
+getRoutes :: Initializer b v [ByteString]
+getRoutes = liftM (map fst) $ iGets _handlers
+
+
+------------------------------------------------------------------------------
-- | Converts a plain hook into a Snaplet hook.
toSnapletHook :: (v -> EitherT Text IO v)
-> (Snaplet v -> EitherT Text IO (Snaplet v))
1  src/Snap/Snaplet/Internal/Types.hs
View
@@ -433,3 +433,4 @@ data ReloadInfo b = ReloadInfo
, riAction :: Initializer b b b
}
+
Please sign in to comment.
Something went wrong with that request. Please try again.