/
App.hs
100 lines (79 loc) · 4.23 KB
/
App.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
module Snap.Snaplet.Auth.App
( App(..)
, auth
, heist
, authInit
, appInit
, appInit'
) where
------------------------------------------------------------------------------
import Control.Lens (makeLenses, (&), (.~))
import Control.Monad.Trans (lift)
import Data.Monoid (mempty)
------------------------------------------------------------------------------
import Data.Map.Syntax (( #! ))
import Heist (Splices, scCompiledSplices)
import qualified Heist.Compiled as C
import Snap.Core (pass)
import Snap.Snaplet (Handler,
Snaplet,
SnapletInit,
makeSnaplet,
nestSnaplet,
subSnaplet,
with)
import Snap.Snaplet.Auth (AuthManager,
AuthSettings(..),
addAuthSplices,
authSettingsFromConfig,
currentUser,
defAuthSettings,
userCSplices)
import Snap.Snaplet.Session (SessionManager)
import Snap.Snaplet.Auth.Backends.JsonFile (initJsonFileAuthManager)
import Snap.Snaplet.Session.Backends.CookieSession (initCookieSessionManager)
import Snap.Snaplet.Heist (Heist,
HasHeist,
addConfig,
heistLens,
heistInit)
import Snap.Snaplet.Session (SessionManager)
------------------------------------------------------------------------------
data App = App
{ _sess :: Snaplet SessionManager
, _auth :: Snaplet (AuthManager App)
, _heist :: Snaplet (Heist App)
}
$(makeLenses ''App)
instance HasHeist App where
heistLens = subSnaplet heist
------------------------------------------------------------------------------
compiledSplices :: Splices (C.Splice (Handler App App))
compiledSplices = do
"userSplice" #! C.withSplices C.runChildren userCSplices $
lift $ maybe pass return =<< with auth currentUser
------------------------------------------------------------------------------
appInit' :: Bool -> SnapletInit App App
appInit' useConfigFile = makeSnaplet "app" "Test application" Nothing $ do
h <- nestSnaplet "heist" heist $ heistInit "templates"
addConfig h $ mempty & scCompiledSplices .~ compiledSplices
s <- nestSnaplet "sess" sess $
initCookieSessionManager "site_key.txt" "sess" (Just 3600)
authSettings <- if useConfigFile
then authSettingsFromConfig
else return defAuthSettings
a <- nestSnaplet "auth" auth $ authInit authSettings
addAuthSplices h auth
return $ App s a h
------------------------------------------------------------------------------
appInit :: SnapletInit App App
appInit = appInit' False
------------------------------------------------------------------------------
authInit :: AuthSettings -> SnapletInit App (AuthManager App)
authInit settings = initJsonFileAuthManager
settings { asLockout = Just (3, 1) }
sess "users.json"