From a48e79e2f7c1ab1ffb52b86ef9e900c75c5d023b Mon Sep 17 00:00:00 2001
From: Joris
Date: Sat, 12 Sep 2015 23:57:16 +0200
Subject: Adding UI income read-only

---
 src/server/Controller/Index.hs   | 12 ++++-----
 src/server/Controller/Payment.hs | 55 ++++++++++++++++++++--------------------
 src/server/Controller/SignIn.hs  | 12 ++++-----
 src/server/Controller/User.hs    | 31 +++++++++++++++-------
 4 files changed, 61 insertions(+), 49 deletions(-)

(limited to 'src/server/Controller')

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 []
   )
-- 
cgit v1.2.3