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/client/elm/Model/Action/AccountAction.elm  |  4 +-
 src/client/elm/Model/Income.elm                | 65 ++++++++++++++-------
 src/client/elm/Model/Init.elm                  |  4 +-
 src/client/elm/Model/Payer.elm                 | 78 +++++++++++---------------
 src/client/elm/Model/Payment.elm               |  8 +++
 src/client/elm/Model/User.elm                  |  6 +-
 src/client/elm/Model/View/LoggedIn/Account.elm | 31 ++++------
 src/client/elm/Model/View/LoggedInView.elm     |  2 +-
 src/client/elm/Server.elm                      |  8 +--
 src/client/elm/Update/LoggedIn.elm             | 36 ++++++------
 src/client/elm/Update/LoggedIn/Account.elm     | 23 +-------
 src/client/elm/View/LoggedIn/Account.elm       |  2 +-
 src/server/Controller/Income.hs                | 31 ++++++++++
 src/server/Controller/Payer.hs                 | 20 -------
 src/server/Controller/User.hs                  | 28 ---------
 src/server/Json.hs                             | 10 ++++
 src/server/Main.hs                             |  8 +--
 src/server/Model/Income.hs                     | 14 +++--
 src/server/Model/Json/Income.hs                |  6 +-
 src/server/Model/Payer.hs                      | 46 ---------------
 src/server/Model/Payer/Income.hs               | 22 --------
 21 files changed, 187 insertions(+), 265 deletions(-)
 create mode 100644 src/server/Controller/Income.hs
 delete mode 100644 src/server/Controller/Payer.hs
 delete mode 100644 src/server/Model/Payer.hs
 delete mode 100644 src/server/Model/Payer/Income.hs

(limited to 'src')

diff --git a/src/client/elm/Model/Action/AccountAction.elm b/src/client/elm/Model/Action/AccountAction.elm
index 520f3ab..3e156a5 100644
--- a/src/client/elm/Model/Action/AccountAction.elm
+++ b/src/client/elm/Model/Action/AccountAction.elm
@@ -5,13 +5,13 @@ module Model.Action.AccountAction
 import Time exposing (Time)
 
 import Model.User exposing (UserId)
+import Model.Income exposing (IncomeId)
 
 type AccountAction =
   NoOp
   | ToggleDetail
-  | UpdatePayer UserId Time Int
   | ToggleIncomeEdition
   | UpdateIncomeEdition String
   | UpdateEditionError String
   | UpdateIncome Time Int
-  | ValidateUpdateIncome Time Int
+  | ValidateUpdateIncome IncomeId Time Int
diff --git a/src/client/elm/Model/Income.elm b/src/client/elm/Model/Income.elm
index 97a5652..f364a8b 100644
--- a/src/client/elm/Model/Income.elm
+++ b/src/client/elm/Model/Income.elm
@@ -1,6 +1,9 @@
 module Model.Income
-  ( Income
-  , incomeDecoder
+  ( Incomes
+  , Income
+  , IncomeId
+  , incomesDecoder
+  , incomeIdDecoder
   , incomeDefinedForAll
   , cumulativeIncomesSince
   ) where
@@ -8,26 +11,46 @@ module Model.Income
 import Json.Decode as Json exposing ((:=))
 import Time exposing (Time, hour)
 import List exposing (..)
+import Dict exposing (Dict)
 
 import Model.Date exposing (timeDecoder)
-import Model.User exposing (UserId)
+import Model.User exposing (UserId, userIdDecoder)
 
 import Utils.Maybe exposing (isJust, catMaybes, maybeToList)
 
+type alias Incomes = Dict IncomeId Income
+
+type alias IncomeId = Int
+
 type alias Income =
-  { creation : Time
+  { userId : UserId
+  , creation : Time
   , amount : Int
   }
 
+incomesDecoder : Json.Decoder Incomes
+incomesDecoder = Json.map Dict.fromList (Json.list incomeWithIdDecoder)
+
+incomeWithIdDecoder : Json.Decoder (IncomeId, Income)
+incomeWithIdDecoder =
+  Json.object2 (,)
+    ("id" := incomeIdDecoder)
+    incomeDecoder
+
+incomeIdDecoder : Json.Decoder IncomeId
+incomeIdDecoder = Json.int
+
 incomeDecoder : Json.Decoder Income
 incomeDecoder =
-  Json.object2 Income
+  Json.object3 Income
+    ("userId" := userIdDecoder)
     ("creation" := timeDecoder)
     ("amount" := Json.int)
 
-incomeDefinedForAll : List (List Income) -> Maybe Time
-incomeDefinedForAll usersIncomes =
-  let firstIncomes = map (head << sortBy .creation) usersIncomes
+incomeDefinedForAll : List UserId -> Incomes -> Maybe Time
+incomeDefinedForAll userIds incomes =
+  let userIncomes = List.map (\userId -> List.filter ((==) userId << .userId) << Dict.values <| incomes) userIds
+      firstIncomes = map (head << sortBy .creation) userIncomes
   in  if all isJust firstIncomes
         then head << reverse << List.sort << map .creation << catMaybes <| firstIncomes
         else Nothing
@@ -38,37 +61,39 @@ cumulativeIncomesSince currentTime since incomes =
 
 getOrderedIncomesSince : Time -> List Income -> List Income
 getOrderedIncomesSince time incomes =
-  let mbStarterIncome = getIncomesAt time incomes
+  let mbStarterIncome = getIncomeAt time incomes
       orderedIncomesSince = filter (\income -> income.creation >= time) incomes
   in  (maybeToList mbStarterIncome) ++ orderedIncomesSince
 
-getIncomesAt : Time -> List Income -> Maybe Income
-getIncomesAt time incomes =
+getIncomeAt : Time -> List Income -> Maybe Income
+getIncomeAt time incomes =
   case incomes of
     [x] ->
       if x.creation < time
-        then Just { creation = time, amount = x.amount }
+        then Just { userId = x.userId, creation = time, amount = x.amount }
         else Nothing
     x1 :: x2 :: xs ->
       if x1.creation < time && x2.creation > time
-        then Just { creation = time, amount = x2.amount }
-        else getIncomesAt time (x2 :: xs)
+        then Just { userId = x2.userId, creation = time, amount = x2.amount }
+        else getIncomeAt time (x2 :: xs)
     [] ->
       Nothing
 
 cumulativeIncome : Time -> List Income -> Int
 cumulativeIncome currentTime incomes =
-  getIncomesWithDuration (incomes ++ [{ creation = currentTime, amount = 0 }])
+  getIncomesWithDuration currentTime (List.sortBy .creation incomes)
     |> map durationIncome
     |> sum
 
-getIncomesWithDuration : List Income -> List (Float, Int)
-getIncomesWithDuration incomes =
+getIncomesWithDuration : Time -> List Income -> List (Float, Int)
+getIncomesWithDuration currentTime incomes =
   case incomes of
-    (income1 :: income2 :: xs) ->
-      (income2.creation - income1.creation, income1.amount) :: (getIncomesWithDuration (income2 :: xs))
-    _ ->
+    [] ->
       []
+    [income] ->
+      [(currentTime - income.creation, income.amount)]
+    (income1 :: income2 :: xs) ->
+      (income2.creation - income1.creation, income1.amount) :: (getIncomesWithDuration currentTime (income2 :: xs))
 
 durationIncome : (Float, Int) -> Int
 durationIncome (duration, income) =
diff --git a/src/client/elm/Model/Init.elm b/src/client/elm/Model/Init.elm
index 490321b..d9dbc36 100644
--- a/src/client/elm/Model/Init.elm
+++ b/src/client/elm/Model/Init.elm
@@ -3,7 +3,7 @@ module Model.Init
   ) where
 
 import Model.Payment exposing (Payments)
-import Model.Payer exposing (Payers)
+import Model.Income exposing (Incomes)
 import Model.User exposing (Users, UserId)
 
 type alias Init =
@@ -12,5 +12,5 @@ type alias Init =
   , payments : Payments
   , monthlyPayments : Payments
   , paymentsCount : Int
-  , payers : Payers
+  , incomes : Incomes
   }
diff --git a/src/client/elm/Model/Payer.elm b/src/client/elm/Model/Payer.elm
index f39a612..9ae1dfa 100644
--- a/src/client/elm/Model/Payer.elm
+++ b/src/client/elm/Model/Payer.elm
@@ -2,8 +2,6 @@ module Model.Payer
   ( Payers
   , Payer
   , ExceedingPayer
-  , payersDecoder
-  , updatePayers
   , getOrderedExceedingPayers
   ) where
 
@@ -12,8 +10,10 @@ import Dict exposing (..)
 import List
 import Maybe
 import Time exposing (Time)
+import Date
 
-import Model.User exposing (UserId, userIdDecoder)
+import Model.Payment exposing (Payments, totalPayments)
+import Model.User exposing (Users, UserId, userIdDecoder)
 import Model.Income exposing (..)
 
 import Utils.Dict exposing (mapValues)
@@ -27,54 +27,22 @@ type alias Payer =
   , incomes : List Income
   }
 
-payersDecoder : Decoder Payers
-payersDecoder = Json.map Dict.fromList (list payerDecoder)
-
-payerDecoder : Decoder (UserId, Payer)
-payerDecoder =
-  object2 (,)
-    ("userId" := userIdDecoder)
-    (object3 Payer
-      ("preIncomePaymentSum" := int)
-      ("postIncomePaymentSum" := int)
-      ("incomes" := list incomeDecoder))
-
-updatePayers : Payers -> UserId -> Time -> Int -> Payers
-updatePayers payers userId creation amountDiff =
-  payers
-    |> Dict.update userId (\mbPayer ->
-       case mbPayer of
-         Just payer ->
-           let postIncome =
-                payersIncomeDefinedForAll payers
-                  |> Maybe.map (\date -> creation > date)
-                  |> Maybe.withDefault False
-           in  if postIncome
-                 then
-                   Just { payer | postIncomePaymentSum = payer.postIncomePaymentSum + amountDiff }
-                 else
-                   Just { payer | preIncomePaymentSum = payer.preIncomePaymentSum + amountDiff }
-         Nothing ->
-           Nothing
-    )
-
 type alias ExceedingPayer =
   { userId : UserId
   , amount : Int
   }
 
-getOrderedExceedingPayers : Time -> Payers -> List ExceedingPayer
-getOrderedExceedingPayers currentTime payers =
-  let exceedingPayersOnPreIncome =
+getOrderedExceedingPayers : Time -> Users -> Incomes -> Payments -> List ExceedingPayer
+getOrderedExceedingPayers currentTime users incomes payments =
+  let payers = getPayers currentTime users incomes payments
+      exceedingPayersOnPreIncome =
         payers
           |> mapValues .preIncomePaymentSum
           |> Dict.toList
           |> exceedingPayersFromAmounts
-  in  case payersIncomeDefinedForAll payers of
+  in  case incomeDefinedForAll (Dict.keys users) incomes of
         Just since ->
-          let postPaymentPayers =
-                payers
-                  |> mapValues (getPostPaymentPayer currentTime since)
+          let postPaymentPayers = mapValues (getPostPaymentPayer currentTime since) payers
               mbMaxRatio =
                 postPaymentPayers
                   |> Dict.toList
@@ -91,9 +59,31 @@ getOrderedExceedingPayers currentTime payers =
         Nothing ->
           exceedingPayersOnPreIncome
 
-payersIncomeDefinedForAll : Payers -> Maybe Time
-payersIncomeDefinedForAll payers =
-  incomeDefinedForAll (List.map (.incomes << snd) << Dict.toList <| payers)
+getPayers : Time -> Users -> Incomes -> Payments -> Payers
+getPayers currentTime users incomes payments =
+  let incomesDefined = incomeDefinedForAll (Dict.keys users) incomes
+  in  Dict.keys users
+        |> List.map (\userId ->
+             ( userId
+             , { preIncomePaymentSum =
+                   totalPayments
+                     (\p -> (Date.toTime p.creation) < (Maybe.withDefault currentTime incomesDefined))
+                     userId
+                     payments
+               , postIncomePaymentSum =
+                   totalPayments
+                     (\p ->
+                       case incomesDefined of
+                         Nothing -> False
+                         Just t -> (Date.toTime p.creation) >= t
+                     )
+                     userId
+                     payments
+               , incomes = List.filter ((==) userId << .userId) (Dict.values incomes)
+               }
+             )
+           )
+        |> Dict.fromList
 
 exceedingPayersFromAmounts : List (UserId, Int) -> List ExceedingPayer
 exceedingPayersFromAmounts userAmounts =
diff --git a/src/client/elm/Model/Payment.elm b/src/client/elm/Model/Payment.elm
index 31aba1d..80579e2 100644
--- a/src/client/elm/Model/Payment.elm
+++ b/src/client/elm/Model/Payment.elm
@@ -7,6 +7,7 @@ module Model.Payment
   , paymentIdDecoder
   , deletePayment
   , PaymentFrequency(..)
+  , totalPayments
   ) where
 
 import Date exposing (..)
@@ -49,3 +50,10 @@ paymentIdDecoder = Json.int
 
 deletePayment : PaymentId -> Payments -> Payments
 deletePayment paymentId = List.filter (((/=) paymentId) << .id)
+
+totalPayments : (Payment -> Bool) -> UserId -> Payments -> Int
+totalPayments paymentFilter userId payments =
+  payments
+    |> List.filter (\payment -> paymentFilter payment && payment.userId == userId)
+    |> List.map .cost
+    |> List.sum
diff --git a/src/client/elm/Model/User.elm b/src/client/elm/Model/User.elm
index 1412913..aac5dd5 100644
--- a/src/client/elm/Model/User.elm
+++ b/src/client/elm/Model/User.elm
@@ -29,15 +29,15 @@ userWithIdDecoder =
     ("id" := userIdDecoder)
     userDecoder
 
+userIdDecoder : Json.Decoder UserId
+userIdDecoder = Json.int
+
 userDecoder : Json.Decoder User
 userDecoder =
   Json.object2 User
     ("name" := Json.string)
     ("email" := Json.string)
 
-userIdDecoder : Json.Decoder UserId
-userIdDecoder = Json.int
-
 getUserName : Users -> UserId -> Maybe String
 getUserName users userId =
   Dict.get userId users
diff --git a/src/client/elm/Model/View/LoggedIn/Account.elm b/src/client/elm/Model/View/LoggedIn/Account.elm
index d03d84f..ec75397 100644
--- a/src/client/elm/Model/View/LoggedIn/Account.elm
+++ b/src/client/elm/Model/View/LoggedIn/Account.elm
@@ -14,40 +14,33 @@ import String
 import Utils.Dict exposing (mapValues)
 
 import Model.Translations exposing (..)
-import Model.Payer exposing (..)
+import Model.Income exposing (..)
 import Model.User exposing (UserId)
 
 type alias Account =
   { me : UserId
-  , payers : Payers
+  , incomes : Incomes
   , visibleDetail : Bool
   , incomeEdition : Maybe IncomeEdition
   }
 
-initAccount : UserId -> Payers -> Account
-initAccount me payers =
+initAccount : UserId -> Incomes -> Account
+initAccount me incomes =
   { me = me
-  , payers =
-      payers
-        |> mapValues
-             (\payer ->
-               { payer | incomes = List.sortBy .creation payer.incomes }
-             )
+  , incomes = incomes
   , visibleDetail = False
   , incomeEdition = Nothing
   }
 
 getCurrentIncome : Account -> Maybe Int
 getCurrentIncome account =
-  case Dict.get account.me account.payers of
-    Just payer ->
-      payer.incomes
-        |> List.sortBy .creation
-        |> List.reverse
-        |> List.head
-        |> Maybe.map .amount
-    Nothing ->
-      Nothing
+  account.incomes
+    |> Dict.filter (\_ income -> income.userId == account.me)
+    |> Dict.values
+    |> List.sortBy .creation
+    |> List.reverse
+    |> List.head
+    |> Maybe.map .amount
 
 type alias IncomeEdition =
   { income : String
diff --git a/src/client/elm/Model/View/LoggedInView.elm b/src/client/elm/Model/View/LoggedInView.elm
index 2df3525..e33c58b 100644
--- a/src/client/elm/Model/View/LoggedInView.elm
+++ b/src/client/elm/Model/View/LoggedInView.elm
@@ -28,7 +28,7 @@ initLoggedInView init =
   { users = init.users
   , add = initAddPayment Punctual
   , monthly = initMonthly init.monthlyPayments
-  , account = initAccount init.me init.payers
+  , account = initAccount init.me init.incomes
   , payments = init.payments
   , paymentsCount = init.paymentsCount
   , paymentEdition = Nothing
diff --git a/src/client/elm/Server.elm b/src/client/elm/Server.elm
index c1fb445..314ca01 100644
--- a/src/client/elm/Server.elm
+++ b/src/client/elm/Server.elm
@@ -17,7 +17,7 @@ import Time exposing (Time)
 import Utils.Http exposing (..)
 
 import Model.Payment exposing (..)
-import Model.Payer exposing (Payers, payersDecoder)
+import Model.Income exposing (incomesDecoder, incomeIdDecoder, IncomeId)
 import Model.User exposing (Users, usersDecoder, UserId, userIdDecoder)
 import Model.Init exposing (Init)
 
@@ -28,7 +28,7 @@ init =
     `Task.andMap` (Http.get paymentsDecoder "/payments")
     `Task.andMap` (Http.get paymentsDecoder "/monthlyPayments")
     `Task.andMap` (Http.get ("number" := Json.int) "/payments/count")
-    `Task.andMap` (Http.get payersDecoder "/payers")
+    `Task.andMap` (Http.get incomesDecoder "/incomes")
 
 signIn : String -> Task Http.Error ()
 signIn email =
@@ -45,10 +45,10 @@ deletePayment payment frequency =
   post ("payment/delete?id=" ++ (toString payment.id))
     |> Task.map (always ())
 
-setIncome : Time -> Int -> Task Http.Error ()
+setIncome : Time -> Int -> Task Http.Error IncomeId
 setIncome currentTime amount =
   post ("/income?amount=" ++ (toString amount))
-    |> Task.map (always ())
+    |> flip Task.andThen (decodeHttpValue <| "id" := incomeIdDecoder)
 
 signOut : Task Http.Error ()
 signOut =
diff --git a/src/client/elm/Update/LoggedIn.elm b/src/client/elm/Update/LoggedIn.elm
index dfc2a1b..300c63a 100644
--- a/src/client/elm/Update/LoggedIn.elm
+++ b/src/client/elm/Update/LoggedIn.elm
@@ -71,17 +71,15 @@ updateLoggedIn model action loggedInView =
           newAdd = initAddPayment frequency
       in  case frequency of
             Punctual ->
-              let (newAccount, accountEffects) =
-                    updateAccount (Account.UpdatePayer loggedInView.account.me model.currentTime cost) loggedInView.account
-              in  ( { loggedInView
-                  | currentPage = 1
-                  , add = newAdd
-                  , account = newAccount
-                  , payments = newPayment :: loggedInView.payments
-                  , paymentsCount = loggedInView.paymentsCount + 1
-                  }
-                , Effects.map UpdateAccount accountEffects
-                )
+              ( { loggedInView
+                | currentPage = 1
+                , add = newAdd
+                , account = loggedInView.account
+                , payments = newPayment :: loggedInView.payments
+                , paymentsCount = loggedInView.paymentsCount + 1
+                }
+              , Effects.none
+              )
             Monthly ->
               ( { loggedInView
                 | add = newAdd
@@ -112,15 +110,13 @@ updateLoggedIn model action loggedInView =
           , Effects.none
           )
         Punctual ->
-          let (newAccount, accountEffects) =
-                updateAccount (Account.UpdatePayer payment.userId (Date.toTime payment.creation) -payment.cost) loggedInView.account
-          in  ( { loggedInView
-                | account = newAccount
-                , payments = deletePayment payment.id loggedInView.payments
-                , paymentsCount = loggedInView.paymentsCount - 1
-                }
-              , Effects.map UpdateAccount accountEffects
-              )
+          ( { loggedInView
+            | account = loggedInView.account
+            , payments = deletePayment payment.id loggedInView.payments
+            , paymentsCount = loggedInView.paymentsCount - 1
+            }
+          , Effects.none
+          )
 
     UpdatePage page ->
       ( { loggedInView | currentPage = page }
diff --git a/src/client/elm/Update/LoggedIn/Account.elm b/src/client/elm/Update/LoggedIn/Account.elm
index 1773b9a..233efa9 100644
--- a/src/client/elm/Update/LoggedIn/Account.elm
+++ b/src/client/elm/Update/LoggedIn/Account.elm
@@ -10,7 +10,6 @@ import Effects exposing (Effects)
 
 import Server
 
-import Model.Payer exposing (updatePayers)
 import Model.Action.AccountAction exposing (..)
 import Model.View.LoggedIn.Account exposing (..)
 
@@ -28,11 +27,6 @@ updateAccount action account =
       , Effects.none
       )
 
-    UpdatePayer userId creation amountDiff ->
-      ( { account | payers = updatePayers account.payers userId creation amountDiff }
-      , Effects.none
-      )
-
     ToggleIncomeEdition ->
       ( { account | incomeEdition =
           if isJust account.incomeEdition
@@ -67,25 +61,14 @@ updateAccount action account =
     UpdateIncome currentTime amount ->
       ( account
       , Server.setIncome currentTime amount
-          |> Task.map (always (ValidateUpdateIncome currentTime amount))
+          |> Task.map (\incomeId -> (ValidateUpdateIncome incomeId currentTime amount))
           |> flip Task.onError (always <| Task.succeed NoOp)
           |> Effects.task
       )
 
-    ValidateUpdateIncome currentTime amount ->
+    ValidateUpdateIncome incomeId currentTime amount ->
       ( { account
-        | payers =
-            account.payers
-              |> Dict.update account.me (\mbPayer ->
-                case mbPayer of
-                  Just payer ->
-                    Just
-                      { payer
-                      | incomes = payer.incomes ++ [{ creation = currentTime, amount = amount }]
-                      }
-                  Nothing ->
-                    Nothing
-              )
+        | incomes = Dict.insert incomeId { userId = account.me, creation = currentTime, amount = amount } account.incomes
         , incomeEdition = Nothing
         }
       , Effects.none
diff --git a/src/client/elm/View/LoggedIn/Account.elm b/src/client/elm/View/LoggedIn/Account.elm
index d8884f1..5bbf73e 100644
--- a/src/client/elm/View/LoggedIn/Account.elm
+++ b/src/client/elm/View/LoggedIn/Account.elm
@@ -48,7 +48,7 @@ exceedingPayers address model loggedInView =
     [ class "header"
     , onClick address (UpdateLoggedIn << UpdateAccount <| ToggleDetail)
     ]
-    (  (List.map (exceedingPayer model loggedInView) (getOrderedExceedingPayers model.currentTime loggedInView.account.payers))
+    (  (List.map (exceedingPayer model loggedInView) (getOrderedExceedingPayers model.currentTime loggedInView.users loggedInView.account.incomes loggedInView.payments))
     ++ [ expand ExpandDown loggedInView.account.visibleDetail ]
     )
 
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
-  )
diff --git a/src/server/Json.hs b/src/server/Json.hs
index a2f1ef5..408742a 100644
--- a/src/server/Json.hs
+++ b/src/server/Json.hs
@@ -1,7 +1,9 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts           #-}
 
 module Json
   ( jsonObject
+  , jsonId
   ) where
 
 import Web.Scotty
@@ -10,5 +12,13 @@ import qualified Data.Aeson.Types as Json
 import qualified Data.HashMap.Strict as M
 import Data.Text (Text)
 
+import Database.Persist
+import Database.Persist.Sqlite
+
+import Model.Database
+
 jsonObject :: [(Text, Json.Value)] -> ActionM ()
 jsonObject = json . Json.Object . M.fromList
+
+jsonId :: (ToBackendKey SqlBackend a) => Key a -> ActionM ()
+jsonId key = json . Json.Object . M.fromList $ [("id", Json.Number . fromIntegral . keyToInt64 $ key)]
diff --git a/src/server/Main.hs b/src/server/Main.hs
index 5688324..4f74f8e 100644
--- a/src/server/Main.hs
+++ b/src/server/Main.hs
@@ -15,7 +15,7 @@ import Controller.Index
 import Controller.SignIn
 import Controller.Payment
 import Controller.User
-import Controller.Payer
+import Controller.Income
 
 import Model.Database (runMigrations)
 import Model.Frequency
@@ -58,7 +58,7 @@ main = do
 
         get  "/users"  getUsers
         get  "/whoAmI" whoAmI
-        get  "/income" getIncome
+        get "/incomes" getIncomes
         post "/income" $ do
           amount <- param "amount" :: ActionM Int
           setIncome amount
@@ -80,7 +80,3 @@ main = do
           deletePayment paymentId
 
         get "/payments/count" getPaymentsCount
-
-        -- Payers
-
-        get "/payers" getPayers
diff --git a/src/server/Model/Income.hs b/src/server/Model/Income.hs
index 70b9149..2177617 100644
--- a/src/server/Model/Income.hs
+++ b/src/server/Model/Income.hs
@@ -1,5 +1,5 @@
 module Model.Income
-  ( getIncome
+  ( getJsonIncome
   , getFirstIncome
   , getIncomes
   , setIncome
@@ -12,13 +12,15 @@ import Control.Monad.IO.Class (liftIO)
 import Database.Persist
 
 import Model.Database
+import qualified Model.Json.Income as Json
 
-getIncome :: UserId -> Persist (Maybe Income)
-getIncome userId =
-  fmap entityVal <$> selectFirst [IncomeUserId ==. userId] [Desc IncomeCreation]
+getJsonIncome :: Entity Income -> Json.Income
+getJsonIncome incomeEntity =
+  Json.Income (entityKey incomeEntity) (incomeUserId income) (incomeCreation income) (incomeAmount income)
+  where income = entityVal incomeEntity
 
-getIncomes :: Persist [Income]
-getIncomes = map entityVal <$> selectList [] []
+getIncomes :: Persist [Entity Income]
+getIncomes = selectList [] []
 
 getFirstIncome :: UserId -> Persist (Maybe Income)
 getFirstIncome userId =
diff --git a/src/server/Model/Json/Income.hs b/src/server/Model/Json/Income.hs
index 4549ca5..6ad331a 100644
--- a/src/server/Model/Json/Income.hs
+++ b/src/server/Model/Json/Income.hs
@@ -9,8 +9,12 @@ import GHC.Generics
 import Data.Aeson
 import Data.Time.Clock (UTCTime)
 
+import Model.Database (IncomeId, UserId)
+
 data Income = Income
-  { creation :: UTCTime
+  { id :: IncomeId
+  , userId :: UserId
+  , creation :: UTCTime
   , amount :: Int
   } deriving (Show, Generic)
 
diff --git a/src/server/Model/Payer.hs b/src/server/Model/Payer.hs
deleted file mode 100644
index 3893765..0000000
--- a/src/server/Model/Payer.hs
+++ /dev/null
@@ -1,46 +0,0 @@
-module Model.Payer
-  ( getPayers
-  )
-  where
-
-import Control.Monad.IO.Class (liftIO)
-
-import Data.Time.Clock (getCurrentTime)
-import Data.List (find)
-import Data.Maybe (fromMaybe, fromMaybe)
-
-import Database.Persist
-
-import Model.Database
-import Model.Payer.Payment (getTotalPaymentsBefore, getTotalPaymentsAfter)
-import Model.Payer.Income (incomeDefinedForAll)
-import Model.User (getUsers)
-import Model.Income (getIncomes)
-
-import qualified Model.Json.Payer as Json
-import qualified Model.Json.Income as Json
-
-getPayers :: Persist [Json.Payer]
-getPayers = do
-  userIds <- map entityKey <$> getUsers
-  incomes <- getIncomes
-  now <- liftIO getCurrentTime
-  incomeIsDefined <- fromMaybe now <$> incomeDefinedForAll
-  preIncomePaymentSums <- getTotalPaymentsBefore incomeIsDefined
-  postIncomePaymentSums <- getTotalPaymentsAfter incomeIsDefined
-  return $ map (getPayer incomes preIncomePaymentSums postIncomePaymentSums) userIds
-
-getPayer :: [Income] -> [(UserId, Int)] -> [(UserId, Int)] -> UserId -> Json.Payer
-getPayer incomes preIncomePaymentSums postIncomePaymentSums userId =
-  Json.Payer
-    { Json.userId = userId
-    , Json.preIncomePaymentSum = findOrDefault userId 0 preIncomePaymentSums
-    , Json.postIncomePaymentSum = findOrDefault userId 0 postIncomePaymentSums
-    , Json.incomes =
-        map (\income -> Json.Income (incomeCreation income) (incomeAmount income))
-        . filter ((==) userId . incomeUserId)
-        $ incomes
-    }
-
-findOrDefault :: (Eq a) => a -> b -> [(a, b)] -> b
-findOrDefault a b = fromMaybe b . fmap snd . find ((==) a . fst)
diff --git a/src/server/Model/Payer/Income.hs b/src/server/Model/Payer/Income.hs
deleted file mode 100644
index f4bc9fd..0000000
--- a/src/server/Model/Payer/Income.hs
+++ /dev/null
@@ -1,22 +0,0 @@
-module Model.Payer.Income
-  ( incomeDefinedForAll
-  ) where
-
-import Data.Time.Clock (UTCTime)
-import Data.List (sort)
-import Data.Maybe
-
-import Database.Persist
-
-import Model.Database
-import Model.User (getUsers)
-import Model.Income (getFirstIncome)
-
-incomeDefinedForAll :: Persist (Maybe UTCTime)
-incomeDefinedForAll = do
-  userIds <- map entityKey <$> getUsers
-  firstIncomes <- mapM getFirstIncome userIds
-  return $
-    if all isJust firstIncomes
-      then listToMaybe . reverse . sort . map incomeCreation . catMaybes $ firstIncomes
-      else Nothing
-- 
cgit v1.2.3