diff options
author | Joris | 2015-09-12 23:57:16 +0200 |
---|---|---|
committer | Joris | 2015-09-12 23:57:16 +0200 |
commit | a48e79e2f7c1ab1ffb52b86ef9e900c75c5d023b (patch) | |
tree | 05a613aef2d338f10bcdd394e520450656ed8f1c /src/server/Controller | |
parent | d87dbd1360c14df83552fd757438c23e5d7b9f9c (diff) |
Adding UI income read-only
Diffstat (limited to 'src/server/Controller')
-rw-r--r-- | src/server/Controller/Index.hs | 12 | ||||
-rw-r--r-- | src/server/Controller/Payment.hs | 55 | ||||
-rw-r--r-- | src/server/Controller/SignIn.hs | 12 | ||||
-rw-r--r-- | src/server/Controller/User.hs | 31 |
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 [] ) |