aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/server/Application.hs13
-rw-r--r--src/server/Main.hs4
-rw-r--r--src/server/Secure.hs23
3 files changed, 34 insertions, 6 deletions
diff --git a/src/server/Application.hs b/src/server/Application.hs
index 377d1ff..b83273f 100644
--- a/src/server/Application.hs
+++ b/src/server/Application.hs
@@ -28,14 +28,19 @@ import qualified Data.Text.Lazy as TL
import qualified LoginSession
+import qualified Secure
+
import Model.Database (runDb)
import Model.User
import Model.Payment
import View.Page (page)
+
getIndexAction :: ActionM ()
-getIndexAction = do
- html $ page
+getIndexAction =
+ Secure.loggedAction (\_ ->
+ html $ page
+ )
getUsersAction :: ActionM ()
getUsersAction = do
@@ -69,8 +74,8 @@ insertPaymentAction email name cost = do
html "Not found"
signIn :: Text -> ActionM ()
-signIn value = do
- LoginSession.put value
+signIn login = do
+ LoginSession.put login
html "Ok"
checkConnection :: ActionM ()
diff --git a/src/server/Main.hs b/src/server/Main.hs
index 69de885..f73f2e0 100644
--- a/src/server/Main.hs
+++ b/src/server/Main.hs
@@ -32,8 +32,8 @@ main = do
insertPaymentAction email name cost
get "/signIn" $ do
- email <- param "email" :: ActionM Text
- signIn email
+ login <- param "login" :: ActionM Text
+ signIn login
get "/checkConnection" $
checkConnection
diff --git a/src/server/Secure.hs b/src/server/Secure.hs
new file mode 100644
index 0000000..94ee8a9
--- /dev/null
+++ b/src/server/Secure.hs
@@ -0,0 +1,23 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Secure
+ ( loggedAction
+ ) where
+
+import Web.Scotty
+
+import Network.HTTP.Types.Status (forbidden403)
+
+import Data.Text (Text)
+
+import qualified LoginSession
+
+loggedAction :: (Text -> ActionM ()) -> ActionM ()
+loggedAction action = do
+ maybeLogin <- LoginSession.get
+ case maybeLogin of
+ Just login ->
+ action login
+ Nothing -> do
+ status forbidden403
+ html "You need to be logged in to perform this action"