aboutsummaryrefslogtreecommitdiff
path: root/src/server/Controller
diff options
context:
space:
mode:
authorJoris2015-09-12 23:57:16 +0200
committerJoris2015-09-12 23:57:16 +0200
commita48e79e2f7c1ab1ffb52b86ef9e900c75c5d023b (patch)
tree05a613aef2d338f10bcdd394e520450656ed8f1c /src/server/Controller
parentd87dbd1360c14df83552fd757438c23e5d7b9f9c (diff)
Adding UI income read-only
Diffstat (limited to 'src/server/Controller')
-rw-r--r--src/server/Controller/Index.hs12
-rw-r--r--src/server/Controller/Payment.hs55
-rw-r--r--src/server/Controller/SignIn.hs12
-rw-r--r--src/server/Controller/User.hs31
4 files changed, 61 insertions, 49 deletions
diff --git a/src/server/Controller/Index.hs b/src/server/Controller/Index.hs
index 17f5ae9..da67051 100644
--- a/src/server/Controller/Index.hs
+++ b/src/server/Controller/Index.hs
@@ -1,6 +1,6 @@
module Controller.Index
- ( getIndexAction
- , signOutAction
+ ( getIndex
+ , signOut
) where
import Web.Scotty
@@ -11,10 +11,10 @@ import qualified LoginSession
import View.Page (page)
-getIndexAction :: ActionM ()
-getIndexAction = html page
+getIndex :: ActionM ()
+getIndex = html page
-signOutAction :: ActionM ()
-signOutAction = do
+signOut :: ActionM ()
+signOut = do
LoginSession.delete
status ok200
diff --git a/src/server/Controller/Payment.hs b/src/server/Controller/Payment.hs
index 85e2a87..02c8a8e 100644
--- a/src/server/Controller/Payment.hs
+++ b/src/server/Controller/Payment.hs
@@ -1,12 +1,12 @@
{-# LANGUAGE OverloadedStrings #-}
module Controller.Payment
- ( getPaymentsAction
- , getMonthlyPaymentsAction
- , createPaymentAction
- , deletePaymentAction
- , getTotalPaymentsAction
- , getPaymentsCountAction
+ ( getPayments
+ , getMonthlyPayments
+ , createPayment
+ , deletePayment
+ , getTotalPayments
+ , getPaymentsCount
) where
import Web.Scotty
@@ -22,40 +22,39 @@ import qualified Data.Aeson.Types as Json
import qualified Secure
+import Json (jsonObject)
+
import Model.Database
-import Model.Payment
+import qualified Model.Payment as P
import Model.Frequency
import Model.Json.Number
import qualified Model.Json.PaymentId as JP
import Model.Message
import Model.Message.Key (Key(PaymentNotDeleted))
-
-import Json (jsonObject)
-
-getPaymentsAction :: Int -> Int -> ActionM ()
-getPaymentsAction page perPage =
+getPayments :: Int -> Int -> ActionM ()
+getPayments page perPage =
Secure.loggedAction (\_ -> do
- (liftIO $ runDb (getPunctualPayments page perPage)) >>= json
+ (liftIO $ runDb (P.getPunctualPayments page perPage)) >>= json
)
-getMonthlyPaymentsAction :: ActionM ()
-getMonthlyPaymentsAction =
+getMonthlyPayments :: ActionM ()
+getMonthlyPayments =
Secure.loggedAction (\user -> do
- (liftIO $ runDb (getUserMonthlyPayments (entityKey user))) >>= json
+ (liftIO $ runDb (P.getUserMonthlyPayments (entityKey user))) >>= json
)
-createPaymentAction :: Text -> Int -> Frequency -> ActionM ()
-createPaymentAction name cost frequency =
+createPayment :: Text -> Int -> Frequency -> ActionM ()
+createPayment name cost frequency =
Secure.loggedAction (\user -> do
- paymentId <- liftIO . runDb $ createPayment (entityKey user) name cost frequency
+ paymentId <- liftIO . runDb $ P.createPayment (entityKey user) name cost frequency
json (JP.PaymentId paymentId)
)
-deletePaymentAction :: Text -> ActionM ()
-deletePaymentAction paymentId =
+deletePayment :: Text -> ActionM ()
+deletePayment paymentId =
Secure.loggedAction (\user -> do
- deleted <- liftIO . runDb $ deleteOwnPayment user (textToKey paymentId)
+ deleted <- liftIO . runDb $ P.deleteOwnPayment user (textToKey paymentId)
if deleted
then
status ok200
@@ -64,14 +63,14 @@ deletePaymentAction paymentId =
jsonObject [("error", Json.String $ getMessage PaymentNotDeleted)]
)
-getTotalPaymentsAction :: ActionM ()
-getTotalPaymentsAction =
+getTotalPayments :: ActionM ()
+getTotalPayments =
Secure.loggedAction (\_ -> do
- (liftIO . runDb $ getTotalPayments) >>= json
+ (liftIO . runDb $ P.getTotalPayments) >>= json
)
-getPaymentsCountAction :: ActionM ()
-getPaymentsCountAction =
+getPaymentsCount :: ActionM ()
+getPaymentsCount =
Secure.loggedAction (\_ -> do
- Number <$> (liftIO . runDb $ getPaymentsCount) >>= json
+ Number <$> (liftIO . runDb $ P.getPaymentsCount) >>= json
)
diff --git a/src/server/Controller/SignIn.hs b/src/server/Controller/SignIn.hs
index 4f41c6e..955ad35 100644
--- a/src/server/Controller/SignIn.hs
+++ b/src/server/Controller/SignIn.hs
@@ -1,8 +1,8 @@
{-# LANGUAGE OverloadedStrings #-}
module Controller.SignIn
- ( signInAction
- , validateSignInAction
+ ( signIn
+ , validateSignIn
) where
import Web.Scotty
@@ -38,8 +38,8 @@ import Json (jsonObject)
import qualified View.Mail.SignIn as SignIn
-signInAction :: Config -> Text -> ActionM ()
-signInAction config login =
+signIn :: Config -> Text -> ActionM ()
+signIn config login =
if isValid (TE.encodeUtf8 login)
then do
maybeUser <- liftIO . runDb $ getUser login
@@ -63,8 +63,8 @@ errorResponse msg = do
status badRequest400
jsonObject [("error", Json.String msg)]
-validateSignInAction :: Config -> Text -> ActionM ()
-validateSignInAction config token = do
+validateSignIn :: Config -> Text -> ActionM ()
+validateSignIn config token = do
maybeSignIn <- liftIO . runDb $ getSignInToken token
now <- liftIO getCurrentTime
case maybeSignIn of
diff --git a/src/server/Controller/User.hs b/src/server/Controller/User.hs
index 95e5fa8..bc99ea5 100644
--- a/src/server/Controller/User.hs
+++ b/src/server/Controller/User.hs
@@ -1,25 +1,38 @@
+{-# LANGUAGE OverloadedStrings #-}
+
module Controller.User
- ( getUsersAction
- , whoAmIAction
+ ( getUsers
+ , whoAmI
+ , getIncome
) where
import Web.Scotty
import Control.Monad.IO.Class (liftIO)
+import qualified Data.Aeson.Types as Json
+
import qualified Secure
+import Json (jsonObject)
+
import Model.Database
-import Model.User
+import qualified Model.User as U
-getUsersAction :: ActionM ()
-getUsersAction =
+getUsers :: ActionM ()
+getUsers =
Secure.loggedAction (\_ -> do
- (liftIO $ map getJsonUser <$> runDb getUsers) >>= json
+ (liftIO $ map U.getJsonUser <$> runDb U.getUsers) >>= json
)
-whoAmIAction :: ActionM ()
-whoAmIAction =
+whoAmI :: ActionM ()
+whoAmI =
Secure.loggedAction (\user -> do
- json (getJsonUser user)
+ json (U.getJsonUser user)
+ )
+
+getIncome :: ActionM ()
+getIncome =
+ Secure.loggedAction (\_ -> do
+ jsonObject []
)