From 869bab77e93e2a6c776a4b1fc35ef0fd5df22f5f Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 27 Mar 2016 17:36:33 +0200 Subject: Compute payers client side rather than server side --- src/server/Controller/Income.hs | 31 +++++++++++++++++++++++++++++++ src/server/Controller/Payer.hs | 20 -------------------- src/server/Controller/User.hs | 28 ---------------------------- 3 files changed, 31 insertions(+), 48 deletions(-) create mode 100644 src/server/Controller/Income.hs delete mode 100644 src/server/Controller/Payer.hs (limited to 'src/server/Controller') diff --git a/src/server/Controller/Income.hs b/src/server/Controller/Income.hs new file mode 100644 index 0000000..51861d3 --- /dev/null +++ b/src/server/Controller/Income.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Controller.Income + ( getIncomes + , setIncome + ) where + +import Web.Scotty + +import Control.Monad.IO.Class (liftIO) + +import Database.Persist + +import qualified Secure + +import Json (jsonId) + +import Model.Database +import qualified Model.Income as Income + +getIncomes :: ActionM () +getIncomes = + Secure.loggedAction (\_ -> + (liftIO $ map Income.getJsonIncome <$> runDb Income.getIncomes) >>= json + ) + +setIncome :: Int -> ActionM () +setIncome amount = + Secure.loggedAction (\user -> do + (liftIO . runDb $ Income.setIncome (entityKey user) amount) >>= jsonId + ) diff --git a/src/server/Controller/Payer.hs b/src/server/Controller/Payer.hs deleted file mode 100644 index 70760ae..0000000 --- a/src/server/Controller/Payer.hs +++ /dev/null @@ -1,20 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Controller.Payer - ( getPayers - ) where - -import Web.Scotty - -import Control.Monad.IO.Class (liftIO) - -import Model.Database -import qualified Model.Payer as P - -import Secure (loggedAction) - -getPayers :: ActionM () -getPayers = - Secure.loggedAction (\_ -> - (liftIO $ runDb P.getPayers) >>= json - ) diff --git a/src/server/Controller/User.hs b/src/server/Controller/User.hs index 420a2d9..1baab18 100644 --- a/src/server/Controller/User.hs +++ b/src/server/Controller/User.hs @@ -3,27 +3,16 @@ module Controller.User ( getUsers , whoAmI - , getIncome - , setIncome ) where import Web.Scotty -import Network.HTTP.Types.Status (ok200) - import Control.Monad.IO.Class (liftIO) -import Database.Persist - -import qualified Data.Aeson.Types as Json - import qualified Secure -import Json (jsonObject) - import Model.Database import qualified Model.User as U -import qualified Model.Income as I getUsers :: ActionM () getUsers = @@ -36,20 +25,3 @@ whoAmI = Secure.loggedAction (\user -> json (U.getJsonUser user) ) - -getIncome :: ActionM () -getIncome = - Secure.loggedAction (\user -> do - mbIncome <- liftIO . runDb . I.getIncome $ entityKey user - case mbIncome of - Just income -> - jsonObject [("income", Json.Number . fromIntegral . incomeAmount $ income)] - Nothing -> - jsonObject [] - ) - -setIncome :: Int -> ActionM () -setIncome amount = - Secure.loggedAction (\user -> - (liftIO . runDb $ I.setIncome (entityKey user) amount) >> status ok200 - ) -- cgit v1.2.3