Skip to content
This repository
Browse code

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
... ... @@ -1,5 +1,5 @@
1 1 name: snap
2   -version: 0.11.1.1
  2 +version: 0.11.2
3 3 synopsis: Top-level package for the Snap Web Framework
4 4 description:
5 5 This is the top-level package for the official Snap Framework libraries.
1  src/Snap/Snaplet.hs
@@ -91,6 +91,7 @@ module Snap.Snaplet
91 91 , addPostInitHook
92 92 , addPostInitHookBase
93 93 , printInfo
  94 + , getRoutes
94 95
95 96 -- * Routes
96 97 -- $routes
54 src/Snap/Snaplet/Auth/SpliceHelpers.hs
@@ -11,10 +11,10 @@
11 11 -}
12 12
13 13 module Snap.Snaplet.Auth.SpliceHelpers
14   - (
15   - addAuthSplices
  14 + ( addAuthSplices
16 15 , compiledAuthSplices
17 16 , userCSplices
  17 + , userISplices
18 18 , ifLoggedIn
19 19 , ifLoggedOut
20 20 , loggedInUser
@@ -61,6 +61,9 @@ addAuthSplices auth = addSplices
61 61 ]
62 62
63 63
  64 +------------------------------------------------------------------------------
  65 +-- | List containing compiled splices for ifLoggedIn, ifLoggedOut, and
  66 +-- loggedInUser.
64 67 compiledAuthSplices :: SnapletLens b (AuthManager b)
65 68 -> [(Text, SnapletCSplice b)]
66 69 compiledAuthSplices auth =
@@ -70,21 +73,44 @@ compiledAuthSplices auth =
70 73 ]
71 74
72 75
  76 +------------------------------------------------------------------------------
  77 +-- | Function to generate interpreted splices from an AuthUser.
  78 +userISplices :: Monad m => AuthUser -> [(Text, I.Splice m)]
  79 +userISplices AuthUser{..} =
  80 + [ ("userId", I.textSplice $ maybe "-" unUid userId)
  81 + , ("userLogin", I.textSplice userLogin)
  82 + , ("userEmail", I.textSplice $ fromMaybe "-" userEmail)
  83 + , ("userActive", I.textSplice $ T.pack $ show $ isNothing userSuspendedAt)
  84 + , ("userLoginCount", I.textSplice $ T.pack $ show userLoginCount)
  85 + , ("userFailedCount", I.textSplice $ T.pack $ show userFailedLoginCount)
  86 + , ("userLoginAt", I.textSplice $ maybe "-" (T.pack . show) userCurrentLoginAt)
  87 + , ("userLastLoginAt", I.textSplice $ maybe "-" (T.pack . show) userLastLoginAt)
  88 + , ("userSuspendedAt", I.textSplice $ maybe "-" (T.pack . show) userSuspendedAt)
  89 + , ("userLoginIP", I.textSplice $ maybe "-" decodeUtf8 userCurrentLoginIp)
  90 + , ("userLastLoginIP", I.textSplice $ maybe "-" decodeUtf8 userLastLoginIp)
  91 + , ("userIfActive", ifISplice (isNothing userSuspendedAt))
  92 + , ("userIfSuspended", ifISplice (isJust userSuspendedAt))
  93 + ]
  94 +
  95 +
  96 +------------------------------------------------------------------------------
  97 +-- | Compiled splices for AuthUser.
73 98 userCSplices :: Monad m => [(Text, C.Promise AuthUser -> C.Splice m)]
74 99 userCSplices = (C.pureSplices $ C.textSplices
75   - [ ("login", userLogin)
76   - , ("email", maybe "-" id . userEmail)
77   - , ("active", T.pack . show . isNothing . userSuspendedAt)
78   - , ("loginCount", T.pack . show . userLoginCount)
79   - , ("failedCount", T.pack . show . userFailedLoginCount)
80   - , ("loginAt", maybe "-" (T.pack . show) . userCurrentLoginAt)
81   - , ("lastLoginAt", maybe "-" (T.pack . show) . userLastLoginAt)
82   - , ("suspendedAt", maybe "-" (T.pack . show) . userSuspendedAt)
83   - , ("loginIP", maybe "-" decodeUtf8 . userCurrentLoginIp)
84   - , ("lastLoginIP", maybe "-" decodeUtf8 . userLastLoginIp)
  100 + [ ("userId", maybe "-" unUid . userId)
  101 + , ("userLogin", userLogin)
  102 + , ("userEmail", fromMaybe "-" . userEmail)
  103 + , ("userActive", T.pack . show . isNothing . userSuspendedAt)
  104 + , ("userLoginCount", T.pack . show . userLoginCount)
  105 + , ("userFailedCount", T.pack . show . userFailedLoginCount)
  106 + , ("userLoginAt", maybe "-" (T.pack . show) . userCurrentLoginAt)
  107 + , ("userLastLoginAt", maybe "-" (T.pack . show) . userLastLoginAt)
  108 + , ("userSuspendedAt", maybe "-" (T.pack . show) . userSuspendedAt)
  109 + , ("userLoginIP", maybe "-" decodeUtf8 . userCurrentLoginIp)
  110 + , ("userLastLoginIP", maybe "-" decodeUtf8 . userLastLoginIp)
85 111 ]) ++
86   - [ ("ifActive", ifCSplice (isNothing . userSuspendedAt))
87   - , ("ifSuspended", ifCSplice (isJust . userSuspendedAt))
  112 + [ ("userIfActive", ifCSplice (isNothing . userSuspendedAt))
  113 + , ("userIfSuspended", ifCSplice (isJust . userSuspendedAt))
88 114 ]
89 115
90 116
8 src/Snap/Snaplet/Internal/Initializer.hs
@@ -21,6 +21,7 @@ module Snap.Snaplet.Internal.Initializer
21 21 , serveSnaplet
22 22 , loadAppConfig
23 23 , printInfo
  24 + , getRoutes
24 25 ) where
25 26
26 27 import Prelude hiding (catch)
@@ -78,6 +79,13 @@ iGets f = Initializer $ do
78 79
79 80
80 81 ------------------------------------------------------------------------------
  82 +-- | Lets you retrieve the list of routes currently set up by an Initializer.
  83 +-- This can be useful in debugging.
  84 +getRoutes :: Initializer b v [ByteString]
  85 +getRoutes = liftM (map fst) $ iGets _handlers
  86 +
  87 +
  88 +------------------------------------------------------------------------------
81 89 -- | Converts a plain hook into a Snaplet hook.
82 90 toSnapletHook :: (v -> EitherT Text IO v)
83 91 -> (Snaplet v -> EitherT Text IO (Snaplet v))
1  src/Snap/Snaplet/Internal/Types.hs
@@ -433,3 +433,4 @@ data ReloadInfo b = ReloadInfo
433 433 , riAction :: Initializer b b b
434 434 }
435 435
  436 +

0 comments on commit da5622c

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