diff options
| -rw-r--r-- | src/server/Application.hs | 13 | ||||
| -rw-r--r-- | src/server/Main.hs | 4 | ||||
| -rw-r--r-- | src/server/Secure.hs | 23 |
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" |