-
Notifications
You must be signed in to change notification settings - Fork 4
/
Router.hs
121 lines (82 loc) · 2.85 KB
/
Router.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
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
{- | The router of the application
The router directs http requests to the relevant handler/action to be taken
-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
module Web.Gathering.Router where
import Web.Gathering.Types
import Web.Gathering.Actions.Auth
import Web.Gathering.Actions.Events
import Web.Gathering.Actions.Attending
import Web.Gathering.Database
import Data.Int (Int32)
import Data.Text (Text)
import Data.Maybe (maybeToList)
import Network.Wai.Middleware.Static (staticPolicy, addBase)
import Web.Spock
-------------
-- Routing --
-------------
-- | This is the router of the app
--
-- It uses hooks to to separate handlers between
-- different authentication and unauthenticated users
--
-- The hooks are defined in Web.Gathering.Actions.Auth
--
appRouter :: App ()
appRouter = prehook baseHook $ do
-- serve static content like css and js that can be found in the static folder
middleware (staticPolicy (addBase "static"))
-- display events
get root $ maybeUser $
displayEvents (take 5 <$> getFutureEvents)
get "events" $ maybeUser $
displayEvents getFutureEvents
get ("events" <//> "past") $ maybeUser $
displayEvents getPastEvents
get ("event" <//> var) $ \(eid :: EventId) ->
maybeUser $ displayEvents (maybeToList <$> getEventById eid)
get ("unsubscribe" <//> var <//> var) $ \(email :: Text) (key :: Text) ->
unsubscribeAction email key
-- authenticate guests
prehook guestOnlyHook $ do
getpost "signup"
signUpAction
getpost "register" $
redirect "signup"
getpost "signin"
signInAction
getpost "login" $
redirect "signin"
get ("verify-user" <//> var <//> var) $ \(key :: Int32) (email :: Text) ->
verificationAction key email
getpost ("lost-password") $
requestResetAction
getpost ("reset-password" <//> var <//> var) $ \(hash :: Text) (email :: Text) ->
resetPasswordAction hash email
-- signed-in users zone
prehook authHook $ do
getpost "settings" $ do
settingsAction
get "signout" $
signOutAction
get "logout" $
redirect "signout"
post ("event" <//> var <//> "attending") $ \(eid :: EventId) ->
attendingAction eid (Just True)
post ("event" <//> var <//> "not-attending") $ \(eid :: EventId) ->
attendingAction eid (Just False)
post ("event" <//> var <//> "remove-attending") $ \(eid :: EventId) ->
attendingAction eid Nothing
-- administrators zone
prehook adminHook $ do
getpost ("event" <//> "new") $
newEventAction Nothing
getpost ("event" <//> var <//> "clone") $ \(eid :: EventId) ->
newEventAction (pure eid)
getpost ("event" <//> var <//> "edit") $ \(eid :: EventId) ->
editEventAction eid
getpost ("event" <//> var <//> "delete") $ \(eid :: EventId) ->
deleteEventAction eid