Add income

23 files changed, 361 insertions, 68 deletions

diff --git a/ISSUES.md b/ISSUES.md
index 04fdf2f..56f158d 100644
--- a/ISSUES.md
+++ b/ISSUES.md
@@ -1,6 +1,6 @@
 ## Income view
 
-- Add an income
+- Take into account modified incomes into payment table
 - Clone an income
 - Edit an income
 - Remove an income
diff --git a/client/client.cabal b/client/client.cabal
index 06e77e0..bfcfc59 100644
--- a/client/client.cabal
+++ b/client/client.cabal
@@ -65,6 +65,8 @@ Executable client
     Util.WaitFor
     View.App
     View.Header
+    View.Income.Add
+    View.Income.Form
     View.Income.Header
     View.Income.Income
     View.Income.Table
diff --git a/client/src/Component.hs b/client/src/Component.hs
index 4c51750..b715a83 100644
--- a/client/src/Component.hs
+++ b/client/src/Component.hs
@@ -4,7 +4,6 @@ import           Component.Button as X
 import           Component.Form   as X
 import           Component.Input  as X
 import           Component.Link   as X
-import           Component.Modal  as X
 import           Component.Pages  as X
 import           Component.Select as X
 import           Component.Table  as X
diff --git a/client/src/View/Income/Add.hs b/client/src/View/Income/Add.hs
new file mode 100644
index 0000000..d83bb51
--- /dev/null
+++ b/client/src/View/Income/Add.hs
@@ -0,0 +1,36 @@
+module View.Income.Add
+  ( view
+  ) where
+
+import           Control.Monad.IO.Class (liftIO)
+import qualified Data.Time.Clock        as Time
+import           Reflex.Dom             (MonadWidget)
+import qualified Reflex.Dom             as R
+
+import           Common.Model           (CreateIncomeForm (..), Income)
+import qualified Common.Msg             as Msg
+import qualified Common.Util.Time       as TimeUtil
+import qualified Component.Modal        as Modal
+import qualified Util.Reflex            as ReflexUtil
+import           View.Income.Form       (FormIn (..), FormOut (..))
+import qualified View.Income.Form       as Form
+
+view :: forall t m. MonadWidget t m => Modal.Content t m Income
+view cancel = do
+
+  currentDay <- liftIO $ Time.getCurrentTime >>= TimeUtil.timeToDay
+
+  form <- R.dyn $
+    return $ Form.view $ FormIn
+      { _formIn_cancel = cancel
+      , _formIn_headerLabel = Msg.get Msg.Income_AddLong
+      , _formIn_amount = ""
+      , _formIn_date = currentDay
+      , _formIn_mkPayload = CreateIncomeForm
+      , _formIn_httpMethod = Form.Post
+      }
+
+  hide <- ReflexUtil.flatten (_formOut_hide <$> form)
+  addIncome <- ReflexUtil.flatten (_formOut_addIncome <$> form)
+
+  return (hide, addIncome)
diff --git a/client/src/View/Income/Form.hs b/client/src/View/Income/Form.hs
new file mode 100644
index 0000000..b8a9094
--- /dev/null
+++ b/client/src/View/Income/Form.hs
@@ -0,0 +1,113 @@
+module View.Income.Form
+  ( view
+  , FormIn(..)
+  , HttpMethod(..)
+  , FormOut(..)
+  ) where
+
+import           Data.Aeson               (ToJSON)
+import           Data.Text                (Text)
+import qualified Data.Text                as T
+import           Data.Time.Calendar       (Day)
+import qualified Data.Time.Calendar       as Calendar
+import qualified Data.Validation          as V
+import           Reflex.Dom               (Event, MonadWidget)
+import qualified Reflex.Dom               as R
+
+import           Common.Model             (Income)
+import qualified Common.Msg               as Msg
+import qualified Common.Validation.Income as IncomeValidation
+import           Component                (ButtonIn (..), InputIn (..),
+                                           InputOut (..))
+import qualified Component                as Component
+import qualified Util.Ajax                as Ajax
+import qualified Util.Either              as EitherUtil
+import qualified Util.Validation          as ValidationUtil
+import qualified Util.WaitFor             as WaitFor
+
+data FormIn t i = FormIn
+  { _formIn_cancel      :: Event t ()
+  , _formIn_headerLabel :: Text
+  , _formIn_amount      :: Text
+  , _formIn_date        :: Day
+  , _formIn_mkPayload   :: Text -> Text -> i
+  , _formIn_httpMethod  :: HttpMethod
+  }
+
+data HttpMethod = Put | Post
+
+data FormOut t = FormOut
+  { _formOut_hide      :: Event t ()
+  , _formOut_addIncome :: Event t Income
+  }
+
+view :: forall t m i. (MonadWidget t m, ToJSON i) => FormIn t i -> m (FormOut t)
+view formIn = do
+  R.divClass "form" $ do
+    R.divClass "formHeader" $
+      R.text (_formIn_headerLabel formIn)
+
+    R.divClass "formContent" $ do
+      rec
+        let reset = R.leftmost
+              [ "" <$ cancel
+              , "" <$ addIncome
+              , "" <$ _formIn_cancel formIn
+              ]
+
+        amount <- _inputOut_raw <$> (Component.input
+          (Component.defaultInputIn
+            { _inputIn_label = Msg.get Msg.Income_Amount
+            , _inputIn_initialValue = _formIn_amount formIn
+            , _inputIn_validation = IncomeValidation.amount
+            })
+          (_formIn_amount formIn <$ reset)
+          confirm)
+
+        let initialDate = T.pack . Calendar.showGregorian . _formIn_date $ formIn
+
+        date <- _inputOut_raw <$> (Component.input
+          (Component.defaultInputIn
+            { _inputIn_label = Msg.get Msg.Income_Date
+            , _inputIn_initialValue = initialDate
+            , _inputIn_inputType = "date"
+            , _inputIn_hasResetButton = False
+            , _inputIn_validation = IncomeValidation.date
+            })
+          (initialDate <$ reset)
+          confirm)
+
+        let income = do
+              a <- amount
+              d <- date
+              return . V.Success $ (_formIn_mkPayload formIn) a d
+
+        (addIncome, cancel, confirm) <- R.divClass "buttons" $ do
+          rec
+            cancel <- Component._buttonOut_clic <$> (Component.button $
+              (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Undo))
+                { _buttonIn_class = R.constDyn "undo" })
+
+            confirm <- Component._buttonOut_clic <$> (Component.button $
+              (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Confirm))
+                { _buttonIn_class = R.constDyn "confirm"
+                , _buttonIn_waiting = waiting
+                , _buttonIn_submit = True
+                })
+
+            (addIncome, waiting) <- WaitFor.waitFor
+              (ajax "/api/income")
+              (ValidationUtil.fireValidation income confirm)
+
+          return (R.fmapMaybe EitherUtil.eitherToMaybe addIncome, cancel, confirm)
+
+      return FormOut
+        { _formOut_hide = R.leftmost [ cancel, () <$ addIncome ]
+        , _formOut_addIncome = addIncome
+        }
+
+  where
+    ajax =
+      case _formIn_httpMethod formIn of
+        Post -> Ajax.postJson
+        Put  -> Ajax.putJson
diff --git a/client/src/View/Income/Header.hs b/client/src/View/Income/Header.hs
index b7170c9..e384161 100644
--- a/client/src/View/Income/Header.hs
+++ b/client/src/View/Income/Header.hs
@@ -1,33 +1,46 @@
 module View.Income.Header
   ( view
   , HeaderIn(..)
+  , HeaderOut(..)
   ) where
 
 import           Control.Monad.IO.Class (liftIO)
 import qualified Data.Maybe             as Maybe
 import qualified Data.Text              as T
 import qualified Data.Time.Clock        as Clock
-import           Reflex.Dom             (MonadWidget)
+import           Reflex.Dom             (Dynamic, Event, MonadWidget)
 import qualified Reflex.Dom             as R
 
 import           Common.Model           (Income (..), Init (..), User (..))
 import qualified Common.Model           as CM
 import qualified Common.Msg             as Msg
 import qualified Common.View.Format     as Format
+import           Component              (ButtonOut (..))
+import qualified Component
+import qualified Component.Modal        as Modal
 import qualified Util.Date              as DateUtil
+import qualified View.Income.Add        as Add
 
-data HeaderIn = HeaderIn
-  { _headerIn_init :: Init
+data HeaderIn t = HeaderIn
+  { _headerIn_init    :: Init
+  , _headerIn_incomes :: Dynamic t [Income]
   }
 
-view :: forall t m. MonadWidget t m => HeaderIn -> m ()
+data HeaderOut t = HeaderOut
+  { _headerOut_addIncome :: Event t Income
+  }
+
+view :: forall t m. MonadWidget t m => HeaderIn t -> m (HeaderOut t)
 view headerIn =
   R.divClass "withMargin" $ do
 
     currentTime <- liftIO Clock.getCurrentTime
 
-    Maybe.fromMaybe R.blank $
-      flip fmap useIncomesFrom $ \since ->
+    R.dyn . R.ffor useIncomesFrom $ \case
+      (Nothing, _) ->
+        R.blank
+
+      (Just since, incomes) ->
         R.el "div" $ do
 
           R.el "h1" $ do
@@ -38,23 +51,39 @@ view headerIn =
             flip mapM_ (_init_users init) $ \user ->
               R.el "li" $
                 R.text $ do
-                  let incomes = filter ((==) (_user_id user) . _income_userId) (_init_incomes init)
+                  let userIncomes = filter ((==) (_user_id user) . _income_userId) incomes
                   T.intercalate " "
                     [ _user_name user
                     , "−"
                     , Format.price (_init_currency init) $
-                      CM.cumulativeIncomesSince currentTime since incomes
+                      CM.cumulativeIncomesSince currentTime since userIncomes
                     ]
 
-    R.divClass "titleButton" $
+    R.divClass "titleButton" $ do
       R.el "h1" $
         R.text $
           Msg.get Msg.Income_MonthlyNet
 
+      addIncome <- _buttonOut_clic <$>
+        (Component.button . Component.defaultButtonIn . R.text $
+          Msg.get Msg.Income_AddLong)
+
+      addIncome <- Modal.view $ Modal.Input
+        { Modal._input_show    = addIncome
+        , Modal._input_content = Add.view
+        }
+
+      return $ HeaderOut
+        { _headerOut_addIncome = addIncome
+        }
+
   where
     init = _headerIn_init headerIn
 
-    useIncomesFrom = CM.useIncomesFrom
-      (map _user_id $_init_users init)
-      (_init_incomes init)
-      (_init_payments init)
+    useIncomesFrom = R.ffor (_headerIn_incomes headerIn) $ \incomes ->
+      ( CM.useIncomesFrom
+        (map _user_id $_init_users init)
+        incomes
+        (_init_payments init)
+      , incomes
+      )
diff --git a/client/src/View/Income/Income.hs b/client/src/View/Income/Income.hs
index b0c6f0b..167aedf 100644
--- a/client/src/View/Income/Income.hs
+++ b/client/src/View/Income/Income.hs
@@ -3,11 +3,11 @@ module View.Income.Income
   , IncomeIn(..)
   ) where
 
-import           Reflex.Dom         (MonadWidget)
+import           Reflex.Dom         (Dynamic, MonadWidget)
 import qualified Reflex.Dom         as R
 
-import           Common.Model       (Init)
-import           View.Income.Header (HeaderIn (..))
+import           Common.Model       (Init (..))
+import           View.Income.Header (HeaderIn (..), HeaderOut (..))
 import qualified View.Income.Header as Header
 import           View.Income.Table  (IncomeTableIn (..))
 import qualified View.Income.Table  as Table
@@ -20,12 +20,21 @@ view :: forall t m. MonadWidget t m => IncomeIn -> m ()
 view incomeIn =
   R.elClass "main" "income" $ do
 
-    Header.view $ HeaderIn
-      { _headerIn_init = _incomeIn_init incomeIn
-      }
+    rec
+
+      incomes <- R.foldDyn
+        (:)
+        (_init_incomes . _incomeIn_init $ incomeIn)
+        (_headerOut_addIncome header)
+
+      header <- Header.view $ HeaderIn
+        { _headerIn_init = _incomeIn_init incomeIn
+        , _headerIn_incomes = incomes
+        }
 
     Table.view $ IncomeTableIn
       { _tableIn_init = _incomeIn_init incomeIn
+      , _tableIn_incomes = incomes
       }
 
     return ()
diff --git a/client/src/View/Income/Table.hs b/client/src/View/Income/Table.hs
index 2e8f4e6..5363ca5 100644
--- a/client/src/View/Income/Table.hs
+++ b/client/src/View/Income/Table.hs
@@ -6,7 +6,7 @@ module View.Income.Table
 import qualified Data.List          as L
 import qualified Data.Maybe         as Maybe
 import           Data.Text          (Text)
-import           Reflex.Dom         (MonadWidget)
+import           Reflex.Dom         (Dynamic, MonadWidget)
 import qualified Reflex.Dom         as R
 
 import           Common.Model       (Income (..), Init (..), User (..))
@@ -16,22 +16,17 @@ import qualified Common.View.Format as Format
 import           Component          (TableIn (..))
 import qualified Component
 
-data IncomeTableIn = IncomeTableIn
-  { _tableIn_init :: Init
+data IncomeTableIn t = IncomeTableIn
+  { _tableIn_init    :: Init
+  , _tableIn_incomes :: Dynamic t [Income]
   }
 
-view :: forall t m. MonadWidget t m => IncomeTableIn -> m ()
+view :: forall t m. MonadWidget t m => IncomeTableIn t -> m ()
 view tableIn = do
 
     Component.table $ TableIn
       { _tableIn_headerLabel = headerLabel
-      , _tableIn_rows =
-        R.constDyn
-        . reverse
-        . L.sortOn _income_date
-        . _init_incomes
-        . _tableIn_init
-        $ tableIn
+      , _tableIn_rows = R.ffor (_tableIn_incomes tableIn) $ reverse . L.sortOn _income_date
       , _tableIn_cell = cell (_tableIn_init tableIn)
       , _tableIn_perPage = 7
       , _tableIn_resetPage = R.never
diff --git a/client/src/View/Payment/Delete.hs b/client/src/View/Payment/Delete.hs
index 521c1a7..dc7e395 100644
--- a/client/src/View/Payment/Delete.hs
+++ b/client/src/View/Payment/Delete.hs
@@ -13,6 +13,7 @@ import qualified Common.Msg      as Msg
 import           Component       (ButtonIn (..), ButtonOut (..))
 import qualified Component       as Component
 import qualified Component.Modal as Modal
+import qualified Component.Modal as Modal
 import qualified Util.Ajax       as Ajax
 import qualified Util.Either     as EitherUtil
 import qualified Util.WaitFor    as WaitFor
diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs
index 6ed3b0e..9db4c7c 100644
--- a/client/src/View/Payment/Header.hs
+++ b/client/src/View/Payment/Header.hs
@@ -111,16 +111,14 @@ payerAndAdd incomes payments users categories paymentCategories currency frequen
             R.dynText . R.ffor exceedingPayer $ \ep ->
               Format.price currency $ _exceedingPayer_amount ep
 
-    addPaymentClic <- _buttonOut_clic <$> (Component.button $ ButtonIn
-      { _buttonIn_class = R.constDyn "addPayment"
-      , _buttonIn_content = R.text $ Msg.get Msg.Payment_Add
-      , _buttonIn_waiting = R.never
-      , _buttonIn_tabIndex = Nothing
-      , _buttonIn_submit = False
-      })
+    addPayment <- _buttonOut_clic <$>
+      (Component.button $
+        (Component.defaultButtonIn (R.text $ Msg.get Msg.Payment_Add))
+          { _buttonIn_class = R.constDyn "addPayment"
+          })
 
     Modal.view $ Modal.Input
-      { Modal._input_show    = addPaymentClic
+      { Modal._input_show    = addPayment
       , Modal._input_content = Add.view $ Add.Input
           { Add._input_categories = categories
           , Add._input_paymentCategories = paymentCategories
diff --git a/common/common.cabal b/common/common.cabal
index 64a3b3e..6c7c779 100644
--- a/common/common.cabal
+++ b/common/common.cabal
@@ -29,6 +29,7 @@ Library
 
   Exposed-modules:
     Common.Model
+    Common.Model.CreateIncomeForm
     Common.Model.CreatePaymentForm
     Common.Model.Email
     Common.Model.Payment
@@ -40,6 +41,7 @@ Library
     Common.Util.Time
     Common.Util.Validation
     Common.Validation.Atomic
+    Common.Validation.Income
     Common.Validation.Payment
     Common.Validation.SignIn
     Common.View.Format
@@ -50,10 +52,10 @@ Library
     Common.Message.Translation
     Common.Model.Category
     Common.Model.CreateCategory
-    Common.Model.CreateIncome
     Common.Model.Currency
     Common.Model.EditCategory
     Common.Model.EditIncome
+    Common.Model.EditIncomeForm
     Common.Model.EditPaymentForm
     Common.Model.Frequency
     Common.Model.Income
diff --git a/common/src/Common/Model.hs b/common/src/Common/Model.hs
index 5b71a84..c9f500b 100644
--- a/common/src/Common/Model.hs
+++ b/common/src/Common/Model.hs
@@ -2,11 +2,12 @@ module Common.Model (module X) where
 
 import           Common.Model.Category          as X
 import           Common.Model.CreateCategory    as X
-import           Common.Model.CreateIncome      as X
+import           Common.Model.CreateIncomeForm  as X
 import           Common.Model.CreatePaymentForm as X
 import           Common.Model.Currency          as X
 import           Common.Model.EditCategory      as X
 import           Common.Model.EditIncome        as X
+import           Common.Model.EditIncomeForm    as X
 import           Common.Model.EditPaymentForm   as X
 import           Common.Model.Email             as X
 import           Common.Model.Frequency         as X
diff --git a/common/src/Common/Model/CreateIncome.hs b/common/src/Common/Model/CreateIncome.hs
deleted file mode 100644
index 644a51c..0000000
--- a/common/src/Common/Model/CreateIncome.hs
+++ /dev/null
@@ -1,14 +0,0 @@
-module Common.Model.CreateIncome
-  ( CreateIncome(..)
-  ) where
-
-import           Data.Aeson         (FromJSON)
-import           Data.Time.Calendar (Day)
-import           GHC.Generics       (Generic)
-
-data CreateIncome = CreateIncome
-  { _createIncome_date   :: Day
-  , _createIncome_amount :: Int
-  } deriving (Show, Generic)
-
-instance FromJSON CreateIncome
diff --git a/common/src/Common/Model/CreateIncomeForm.hs b/common/src/Common/Model/CreateIncomeForm.hs
new file mode 100644
index 0000000..e83bf0a
--- /dev/null
+++ b/common/src/Common/Model/CreateIncomeForm.hs
@@ -0,0 +1,15 @@
+module Common.Model.CreateIncomeForm
+  ( CreateIncomeForm(..)
+  ) where
+
+import           Data.Aeson   (FromJSON, ToJSON)
+import           Data.Text    (Text)
+import           GHC.Generics (Generic)
+
+data CreateIncomeForm = CreateIncomeForm
+  { _createIncomeForm_amount :: Text
+  , _createIncomeForm_date   :: Text
+  } deriving (Show, Generic)
+
+instance FromJSON CreateIncomeForm
+instance ToJSON CreateIncomeForm
diff --git a/common/src/Common/Model/EditIncomeForm.hs b/common/src/Common/Model/EditIncomeForm.hs
new file mode 100644
index 0000000..ff975fc
--- /dev/null
+++ b/common/src/Common/Model/EditIncomeForm.hs
@@ -0,0 +1,18 @@
+module Common.Model.EditIncomeForm
+  ( EditIncomeForm(..)
+  ) where
+
+import           Data.Aeson          (FromJSON, ToJSON)
+import           Data.Text           (Text)
+import           GHC.Generics        (Generic)
+
+import           Common.Model.Income (IncomeId)
+
+data EditIncomeForm = EditIncomeForm
+  { _editIncomeForm_id     :: IncomeId
+  , _editIncomeForm_amount :: Text
+  , _editIncomeForm_date   :: Text
+  } deriving (Show, Generic)
+
+instance FromJSON EditIncomeForm
+instance ToJSON EditIncomeForm
diff --git a/common/src/Common/Validation/Income.hs b/common/src/Common/Validation/Income.hs
new file mode 100644
index 0000000..7a58bab
--- /dev/null
+++ b/common/src/Common/Validation/Income.hs
@@ -0,0 +1,17 @@
+module Common.Validation.Income
+  ( amount
+  , date
+  ) where
+
+import           Data.Text                (Text)
+import           Data.Time.Calendar       (Day)
+import           Data.Validation          (Validation)
+import qualified Data.Validation          as V
+
+import qualified Common.Validation.Atomic as Atomic
+
+amount :: Text -> Validation Text Int
+amount input = V.bindValidation (Atomic.number input) Atomic.nonNullNumber
+
+date :: Text -> Validation Text Day
+date = Atomic.day
diff --git a/common/src/Common/Validation/Payment.hs b/common/src/Common/Validation/Payment.hs
index 1bb00ce..e3c447a 100644
--- a/common/src/Common/Validation/Payment.hs
+++ b/common/src/Common/Validation/Payment.hs
@@ -14,7 +14,6 @@ import           Common.Model             (CategoryId)
 import qualified Common.Msg               as Msg
 import qualified Common.Validation.Atomic as Atomic
 
-
 name :: Text -> Validation Text Text
 name = Atomic.nonEmpty
 
diff --git a/server/server.cabal b/server/server.cabal
index 426f521..022d496 100644
--- a/server/server.cabal
+++ b/server/server.cabal
@@ -94,7 +94,9 @@ Executable server
     Job.WeeklyReport
     Json
     LoginSession
+    Model.CreateIncome
     Model.CreatePayment
+    Model.EditIncome
     Model.EditPayment
     Model.IncomeResource
     Model.Mail
@@ -113,6 +115,7 @@ Executable server
     Secure
     SendMail
     Util.Time
+    Validation.Income
     Validation.Payment
     View.Mail.SignIn
     View.Mail.WeeklyReport
diff --git a/server/src/Controller/Income.hs b/server/src/Controller/Income.hs
index ed58ac8..e013849 100644
--- a/server/src/Controller/Income.hs
+++ b/server/src/Controller/Income.hs
@@ -5,21 +5,32 @@ module Controller.Income
   ) where
 
 import           Control.Monad.IO.Class    (liftIO)
+import           Data.Validation           (Validation (Failure, Success))
 import qualified Network.HTTP.Types.Status as Status
 import           Web.Scotty                hiding (delete)
 
-import           Common.Model              (CreateIncome (..), EditIncome (..),
-                                            IncomeId, User (..))
+import           Common.Model              (CreateIncomeForm (..),
+                                            EditIncome (..), IncomeId,
+                                            User (..))
 
-import           Json                      (jsonId)
+import qualified Controller.Helper         as ControllerHelper
+import           Model.CreateIncome        (CreateIncome (..))
 import qualified Model.Query               as Query
 import qualified Persistence.Income        as IncomePersistence
 import qualified Secure
+import qualified Validation.Income         as IncomeValidation
 
-create :: CreateIncome -> ActionM ()
-create (CreateIncome date amount) =
+create :: CreateIncomeForm -> ActionM ()
+create form =
   Secure.loggedAction (\user ->
-    (liftIO . Query.run $ IncomePersistence.create (_user_id user) date amount) >>= jsonId
+    (liftIO . Query.run $ do
+      case IncomeValidation.createIncome form of
+        Success (CreateIncome amount date) -> do
+          Right <$> (IncomePersistence.create (_user_id user) date amount)
+
+        Failure validationError ->
+          return $ Left validationError
+    ) >>= ControllerHelper.jsonOrBadRequest
   )
 
 edit :: EditIncome -> ActionM ()
diff --git a/server/src/Model/CreateIncome.hs b/server/src/Model/CreateIncome.hs
new file mode 100644
index 0000000..82451d2
--- /dev/null
+++ b/server/src/Model/CreateIncome.hs
@@ -0,0 +1,10 @@
+module Model.CreateIncome
+  ( CreateIncome(..)
+  ) where
+
+import           Data.Time.Calendar (Day)
+
+data CreateIncome = CreateIncome
+  { _createIncome_amount :: Int
+  , _createIncome_date   :: Day
+  } deriving (Show)
diff --git a/server/src/Model/EditIncome.hs b/server/src/Model/EditIncome.hs
new file mode 100644
index 0000000..ac3d311
--- /dev/null
+++ b/server/src/Model/EditIncome.hs
@@ -0,0 +1,13 @@
+module Model.EditIncome
+  ( EditIncome(..)
+  ) where
+
+import           Data.Time.Calendar (Day)
+
+import           Common.Model       (IncomeId)
+
+data EditIncome = EditIncome
+  { _editIncome_id     :: IncomeId
+  , _editIncome_amount :: Int
+  , _editIncome_date   :: Day
+  } deriving (Show)
diff --git a/server/src/Persistence/Income.hs b/server/src/Persistence/Income.hs
index cee9892..a0c3bbf 100644
--- a/server/src/Persistence/Income.hs
+++ b/server/src/Persistence/Income.hs
@@ -36,15 +36,24 @@ list =
       SQLite.query_ conn "SELECT * FROM income WHERE deleted_at IS NULL"
   )
 
-create :: UserId -> Day -> Int -> Query IncomeId
-create incomeUserId incomeDate incomeAmount =
+create :: UserId -> Day -> Int -> Query Income
+create userId date amount =
   Query (\conn -> do
-    now <- getCurrentTime
+    createdAt <- getCurrentTime
     SQLite.execute
       conn
       "INSERT INTO income (user_id, date, amount, created_at) VALUES (?, ?, ?, ?)"
-      (incomeUserId, incomeDate, incomeAmount, now)
-    SQLite.lastInsertRowId conn
+      (userId, date, amount, createdAt)
+    incomeId <- SQLite.lastInsertRowId conn
+    return $ Income
+      { _income_id        = incomeId
+      , _income_userId    = userId
+      , _income_date      = date
+      , _income_amount    = amount
+      , _income_createdAt = createdAt
+      , _income_editedAt  = Nothing
+      , _income_deletedAt = Nothing
+      }
   )
 
 edit :: UserId -> IncomeId -> Day -> Int -> Query Bool
diff --git a/server/src/Validation/Income.hs b/server/src/Validation/Income.hs
new file mode 100644
index 0000000..5e034d1
--- /dev/null
+++ b/server/src/Validation/Income.hs
@@ -0,0 +1,27 @@
+module Validation.Income
+  ( createIncome
+  , editIncome
+  ) where
+
+import           Data.Text                (Text)
+import           Data.Validation          (Validation)
+import qualified Data.Validation          as V
+
+import           Common.Model             (CreateIncomeForm (..),
+                                           EditIncomeForm (..))
+import qualified Common.Validation.Income as IncomeValidation
+import           Model.CreateIncome       (CreateIncome (..))
+import           Model.EditIncome         (EditIncome (..))
+
+createIncome :: CreateIncomeForm -> Validation Text CreateIncome
+createIncome form =
+  CreateIncome
+    <$> IncomeValidation.amount (_createIncomeForm_amount form)
+    <*> IncomeValidation.date (_createIncomeForm_date form)
+
+editIncome :: EditIncomeForm -> Validation Text EditIncome
+editIncome form =
+  EditIncome
+    <$> V.Success (_editIncomeForm_id form)
+    <*> IncomeValidation.amount (_editIncomeForm_amount form)
+    <*> IncomeValidation.date (_editIncomeForm_date form)