From 7529a18ff0ac443e7f9764b5e2d0f57a5d3a850b Mon Sep 17 00:00:00 2001
From: Joris
Date: Wed, 9 Oct 2019 23:16:00 +0200
Subject: Use common payment validation in the backend

Remove deprecated backend validation
---
 ISSUES.md                                    |  4 --
 client/src/Component/Select.hs               | 11 ++---
 client/src/View/Payment/Add.hs               | 35 +++++++------
 client/src/View/Payment/Clone.hs             | 35 +++++++------
 client/src/View/Payment/Edit.hs              | 27 +++++-----
 client/src/View/Payment/Form.hs              | 12 ++---
 client/src/View/Payment/Header.hs            |  3 +-
 common/common.cabal                          |  4 +-
 common/src/Common/Model.hs                   | 38 +++++++--------
 common/src/Common/Model/CreatePayment.hs     | 34 -------------
 common/src/Common/Model/CreatePaymentForm.hs | 21 ++++++++
 common/src/Common/Model/EditPayment.hs       | 24 ---------
 common/src/Common/Model/EditPaymentForm.hs   | 23 +++++++++
 common/src/Common/Validation/Payment.hs      | 15 +++++-
 server/server.cabal                          |  7 ++-
 server/src/Controller/Helper.hs              | 17 +++++++
 server/src/Controller/Payment.hs             | 73 +++++++++++++++-------------
 server/src/Model/CreatePayment.hs            | 16 ++++++
 server/src/Model/EditPayment.hs              | 17 +++++++
 server/src/Validation/Atomic.hs              | 32 ------------
 server/src/Validation/CreatePayment.hs       | 25 ----------
 server/src/Validation/Payment.hs             | 33 +++++++++++++
 22 files changed, 264 insertions(+), 242 deletions(-)
 delete mode 100644 common/src/Common/Model/CreatePayment.hs
 create mode 100644 common/src/Common/Model/CreatePaymentForm.hs
 delete mode 100644 common/src/Common/Model/EditPayment.hs
 create mode 100644 common/src/Common/Model/EditPaymentForm.hs
 create mode 100644 server/src/Controller/Helper.hs
 create mode 100644 server/src/Model/CreatePayment.hs
 create mode 100644 server/src/Model/EditPayment.hs
 delete mode 100644 server/src/Validation/Atomic.hs
 delete mode 100644 server/src/Validation/CreatePayment.hs
 create mode 100644 server/src/Validation/Payment.hs

diff --git a/ISSUES.md b/ISSUES.md
index ba8d15f..1286596 100644
--- a/ISSUES.md
+++ b/ISSUES.md
@@ -2,10 +2,6 @@
 
 - Implement routing
 
-## Payment view
-
-- Remove old validation, use client validation on the backend
-
 ## Income view
 
 - Show the income table
diff --git a/client/src/Component/Select.hs b/client/src/Component/Select.hs
index 5980ed2..102f554 100644
--- a/client/src/Component/Select.hs
+++ b/client/src/Component/Select.hs
@@ -9,11 +9,10 @@ import qualified Data.Map        as M
 import qualified Data.Maybe      as Maybe
 import           Data.Text       (Text)
 import qualified Data.Text       as T
-import           Data.Validation (Validation (Failure, Success))
+import           Data.Validation (Validation)
 import           Reflex.Dom      (Dynamic, Event, MonadWidget, Reflex)
 import qualified Reflex.Dom      as R
 
-import qualified Common.Msg      as Msg
 import qualified Util.Validation as ValidationUtil
 
 data (Reflex t) => SelectIn t a b c = SelectIn
@@ -22,7 +21,7 @@ data (Reflex t) => SelectIn t a b c = SelectIn
   , _selectIn_value        :: Event t a
   , _selectIn_values       :: Dynamic t (Map a Text)
   , _selectIn_reset        :: Event t b
-  , _selectIn_isValid      :: a -> Bool
+  , _selectIn_isValid      :: a -> Validation Text a
   , _selectIn_validate     :: Event t c
   }
 
@@ -41,11 +40,7 @@ select selectIn = do
             ])
 
         validatedValue =
-          R.ffor value (\v ->
-            if _selectIn_isValid selectIn v then
-              Success v
-            else
-              Failure (Msg.get Msg.Form_NonEmpty))
+          fmap (_selectIn_isValid selectIn) value
 
         maybeError =
           fmap ValidationUtil.maybeError validatedValue
diff --git a/client/src/View/Payment/Add.hs b/client/src/View/Payment/Add.hs
index e83dba9..28c0148 100644
--- a/client/src/View/Payment/Add.hs
+++ b/client/src/View/Payment/Add.hs
@@ -3,23 +3,22 @@ module View.Payment.Add
   , Input(..)
   ) where
 
-import           Control.Monad             (join)
-import           Control.Monad.IO.Class    (liftIO)
-import qualified Data.Text                 as T
-import qualified Data.Time.Clock           as Time
-import           Reflex.Dom                (Dynamic, Event, MonadWidget)
-import qualified Reflex.Dom                as R
-
-import           Common.Model              (Category (..), CreatePayment (..),
-                                            Frequency (..), Payment (..),
-                                            PaymentCategory (..),
-                                            SavedPayment (..))
-import qualified Common.Msg                as Msg
-import qualified Common.Util.Time          as TimeUtil
-import qualified Common.Validation.Payment as PaymentValidation
-import qualified Component.Modal           as Modal
-import qualified Util.Reflex               as ReflexUtil
-import qualified View.Payment.Form         as Form
+import           Control.Monad          (join)
+import           Control.Monad.IO.Class (liftIO)
+import qualified Data.Text              as T
+import qualified Data.Time.Clock        as Time
+import           Reflex.Dom             (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom             as R
+
+import           Common.Model           (Category (..), CreatePaymentForm (..),
+                                         Frequency (..), Payment (..),
+                                         PaymentCategory (..),
+                                         SavedPayment (..))
+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 qualified View.Payment.Form      as Form
 
 data Input t = Input
   { _input_categories        :: [Category]
@@ -45,7 +44,7 @@ view input cancel = do
       , Form._input_date = currentDay
       , Form._input_category = -1
       , Form._input_frequency = frequency
-      , Form._input_mkPayload = CreatePayment
+      , Form._input_mkPayload = CreatePaymentForm
       , Form._input_httpMethod = Form.Post
       }
 
diff --git a/client/src/View/Payment/Clone.hs b/client/src/View/Payment/Clone.hs
index 922e89c..60694ca 100644
--- a/client/src/View/Payment/Clone.hs
+++ b/client/src/View/Payment/Clone.hs
@@ -3,23 +3,22 @@ module View.Payment.Clone
   , view
   ) where
 
-import qualified Control.Monad             as Monad
-import           Control.Monad.IO.Class    (liftIO)
-import qualified Data.Text                 as T
-import qualified Data.Time.Clock           as Time
-import           Reflex.Dom                (Dynamic, Event, MonadWidget)
-import qualified Reflex.Dom                as R
-
-import           Common.Model              (Category (..), CategoryId,
-                                            CreatePayment (..), Frequency (..),
-                                            Payment (..), PaymentCategory (..),
-                                            SavedPayment (..))
-import qualified Common.Msg                as Msg
-import qualified Common.Util.Time          as TimeUtil
-import qualified Common.Validation.Payment as PaymentValidation
-import qualified Component.Modal           as Modal
-import qualified Util.Reflex               as ReflexUtil
-import qualified View.Payment.Form         as Form
+import qualified Control.Monad          as Monad
+import           Control.Monad.IO.Class (liftIO)
+import qualified Data.Text              as T
+import qualified Data.Time.Clock        as Time
+import           Reflex.Dom             (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom             as R
+
+import           Common.Model           (Category (..), CategoryId,
+                                         CreatePaymentForm (..), Frequency (..),
+                                         Payment (..), PaymentCategory (..),
+                                         SavedPayment (..))
+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 qualified View.Payment.Form      as Form
 
 data Input t = Input
   { _input_show              :: Event t ()
@@ -48,7 +47,7 @@ view input cancel = do
       , Form._input_date = currentDay
       , Form._input_category = category
       , Form._input_frequency = _payment_frequency payment
-      , Form._input_mkPayload = CreatePayment
+      , Form._input_mkPayload = CreatePaymentForm
       , Form._input_httpMethod = Form.Post
       }
 
diff --git a/client/src/View/Payment/Edit.hs b/client/src/View/Payment/Edit.hs
index 9c11af0..0361602 100644
--- a/client/src/View/Payment/Edit.hs
+++ b/client/src/View/Payment/Edit.hs
@@ -3,20 +3,19 @@ module View.Payment.Edit
   , view
   ) where
 
-import qualified Control.Monad             as Monad
-import qualified Data.Text                 as T
-import           Reflex.Dom                (Dynamic, Event, MonadWidget)
-import qualified Reflex.Dom                as R
+import qualified Control.Monad     as Monad
+import qualified Data.Text         as T
+import           Reflex.Dom        (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom        as R
 
-import           Common.Model              (Category (..), CategoryId,
-                                            EditPayment (..), Frequency (..),
-                                            Payment (..), PaymentCategory (..),
-                                            SavedPayment (..))
-import qualified Common.Msg                as Msg
-import qualified Common.Validation.Payment as PaymentValidation
-import qualified Component.Modal           as Modal
-import qualified Util.Reflex               as ReflexUtil
-import qualified View.Payment.Form         as Form
+import           Common.Model      (Category (..), CategoryId,
+                                    EditPaymentForm (..), Frequency (..),
+                                    Payment (..), PaymentCategory (..),
+                                    SavedPayment (..))
+import qualified Common.Msg        as Msg
+import qualified Component.Modal   as Modal
+import qualified Util.Reflex       as ReflexUtil
+import qualified View.Payment.Form as Form
 
 data Input t = Input
   { _input_show              :: Event t ()
@@ -43,7 +42,7 @@ view input cancel = do
       , Form._input_date = _payment_date payment
       , Form._input_category = category
       , Form._input_frequency = _payment_frequency payment
-      , Form._input_mkPayload = EditPayment (_payment_id payment)
+      , Form._input_mkPayload = EditPaymentForm (_payment_id payment)
       , Form._input_httpMethod = Form.Put
       }
 
diff --git a/client/src/View/Payment/Form.hs b/client/src/View/Payment/Form.hs
index 9889638..187b64b 100644
--- a/client/src/View/Payment/Form.hs
+++ b/client/src/View/Payment/Form.hs
@@ -46,7 +46,7 @@ data Input t p = Input
   , _input_date              :: Day
   , _input_category          :: CategoryId
   , _input_frequency         :: Frequency
-  , _input_mkPayload         :: Text -> Int -> Day -> CategoryId -> Frequency -> p
+  , _input_mkPayload         :: Text -> Text -> Text -> CategoryId -> Frequency -> p
   , _input_httpMethod        :: HttpMethod
   }
 
@@ -80,7 +80,7 @@ view input = do
           (_input_name input <$ reset)
           confirm
 
-        cost <- _inputOut_value <$> (Component.input
+        cost <- _inputOut_raw <$> (Component.input
           (Component.defaultInputIn
             { _inputIn_label = Msg.get Msg.Payment_Cost
             , _inputIn_initialValue = _input_cost input
@@ -91,7 +91,7 @@ view input = do
 
         let initialDate = T.pack . Calendar.showGregorian . _input_date $ input
 
-        date <- _inputOut_value <$> (Component.input
+        date <- _inputOut_raw <$> (Component.input
           (Component.defaultInputIn
             { _inputIn_label = Msg.get Msg.Payment_Date
             , _inputIn_initialValue = initialDate
@@ -113,7 +113,7 @@ view input = do
           , _selectIn_value = setCategory
           , _selectIn_values = R.constDyn categories
           , _selectIn_reset = _input_category input <$ reset
-          , _selectIn_isValid = (/= -1)
+          , _selectIn_isValid = PaymentValidation.category (map _category_id $ _input_categories input)
           , _selectIn_validate = confirm
           })
 
@@ -124,8 +124,8 @@ view input = do
               cat <- category
               return ((_input_mkPayload input)
                 <$> ValidationUtil.nelError n
-                <*> ValidationUtil.nelError c
-                <*> ValidationUtil.nelError d
+                <*> V.Success c
+                <*> V.Success d
                 <*> ValidationUtil.nelError cat
                 <*> V.Success (_input_frequency input))
 
diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs
index 7281195..6ed3b0e 100644
--- a/client/src/View/Payment/Header.hs
+++ b/client/src/View/Payment/Header.hs
@@ -13,6 +13,7 @@ import           Data.Text              (Text)
 import qualified Data.Text              as T
 import           Data.Time              (NominalDiffTime)
 import qualified Data.Time              as Time
+import qualified Data.Validation        as V
 import           Prelude                hiding (init)
 import           Reflex.Dom             (Dynamic, Event, MonadWidget, Reflex)
 import qualified Reflex.Dom             as R
@@ -150,7 +151,7 @@ searchLine reset = do
         , _selectIn_value        = R.never
         , _selectIn_values       = R.constDyn frequencies
         , _selectIn_reset        = R.never
-        , _selectIn_isValid      = const True
+        , _selectIn_isValid      = V.Success
         , _selectIn_validate     = R.never
         })
 
diff --git a/common/common.cabal b/common/common.cabal
index a454270..64a3b3e 100644
--- a/common/common.cabal
+++ b/common/common.cabal
@@ -29,7 +29,7 @@ Library
 
   Exposed-modules:
     Common.Model
-    Common.Model.CreatePayment
+    Common.Model.CreatePaymentForm
     Common.Model.Email
     Common.Model.Payment
     Common.Model.SavedPayment
@@ -54,7 +54,7 @@ Library
     Common.Model.Currency
     Common.Model.EditCategory
     Common.Model.EditIncome
-    Common.Model.EditPayment
+    Common.Model.EditPaymentForm
     Common.Model.Frequency
     Common.Model.Income
     Common.Model.Init
diff --git a/common/src/Common/Model.hs b/common/src/Common/Model.hs
index 1abc3e3..5b71a84 100644
--- a/common/src/Common/Model.hs
+++ b/common/src/Common/Model.hs
@@ -1,21 +1,21 @@
 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.CreatePayment   as X
-import           Common.Model.Currency        as X
-import           Common.Model.EditCategory    as X
-import           Common.Model.EditIncome      as X
-import           Common.Model.EditPayment     as X
-import           Common.Model.Email           as X
-import           Common.Model.Frequency       as X
-import           Common.Model.Income          as X
-import           Common.Model.Init            as X
-import           Common.Model.InitResult      as X
-import           Common.Model.Payer           as X
-import           Common.Model.Payment         as X
-import           Common.Model.PaymentCategory as X
-import           Common.Model.SavedPayment    as X
-import           Common.Model.SignInForm      as X
-import           Common.Model.User            as X
+import           Common.Model.Category          as X
+import           Common.Model.CreateCategory    as X
+import           Common.Model.CreateIncome      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.EditPaymentForm   as X
+import           Common.Model.Email             as X
+import           Common.Model.Frequency         as X
+import           Common.Model.Income            as X
+import           Common.Model.Init              as X
+import           Common.Model.InitResult        as X
+import           Common.Model.Payer             as X
+import           Common.Model.Payment           as X
+import           Common.Model.PaymentCategory   as X
+import           Common.Model.SavedPayment      as X
+import           Common.Model.SignInForm        as X
+import           Common.Model.User              as X
diff --git a/common/src/Common/Model/CreatePayment.hs b/common/src/Common/Model/CreatePayment.hs
deleted file mode 100644
index c61423c..0000000
--- a/common/src/Common/Model/CreatePayment.hs
+++ /dev/null
@@ -1,34 +0,0 @@
-module Common.Model.CreatePayment
-  ( CreatePaymentError(..)
-  , CreatePayment(..)
-  ) where
-
-import           Data.Aeson             (FromJSON, ToJSON)
-import           Data.Text              (Text)
-import           Data.Time.Calendar     (Day)
-import           GHC.Generics           (Generic)
-
-import           Common.Model.Category  (CategoryId)
-import           Common.Model.Frequency (Frequency)
-
-data CreatePaymentError = CreatePaymentError
-  { _createPaymentError_name      :: Maybe Text
-  , _createPaymentError_cost      :: Maybe Text
-  , _createPaymentError_date      :: Maybe Text
-  , _createPaymentError_category  :: Maybe Text
-  , _createPaymentError_frequency :: Maybe Text
-  } deriving (Show, Generic)
-
-instance FromJSON CreatePaymentError
-instance ToJSON CreatePaymentError
-
-data CreatePayment = CreatePayment
-  { _createPayment_name      :: Text
-  , _createPayment_cost      :: Int
-  , _createPayment_date      :: Day
-  , _createPayment_category  :: CategoryId
-  , _createPayment_frequency :: Frequency
-  } deriving (Show, Generic)
-
-instance FromJSON CreatePayment
-instance ToJSON CreatePayment
diff --git a/common/src/Common/Model/CreatePaymentForm.hs b/common/src/Common/Model/CreatePaymentForm.hs
new file mode 100644
index 0000000..60c5423
--- /dev/null
+++ b/common/src/Common/Model/CreatePaymentForm.hs
@@ -0,0 +1,21 @@
+module Common.Model.CreatePaymentForm
+  ( CreatePaymentForm(..)
+  ) where
+
+import           Data.Aeson             (FromJSON, ToJSON)
+import           Data.Text              (Text)
+import           GHC.Generics           (Generic)
+
+import           Common.Model.Category  (CategoryId)
+import           Common.Model.Frequency (Frequency)
+
+data CreatePaymentForm = CreatePaymentForm
+  { _createPaymentForm_name      :: Text
+  , _createPaymentForm_cost      :: Text
+  , _createPaymentForm_date      :: Text
+  , _createPaymentForm_category  :: CategoryId
+  , _createPaymentForm_frequency :: Frequency
+  } deriving (Show, Generic)
+
+instance FromJSON CreatePaymentForm
+instance ToJSON CreatePaymentForm
diff --git a/common/src/Common/Model/EditPayment.hs b/common/src/Common/Model/EditPayment.hs
deleted file mode 100644
index 8860b84..0000000
--- a/common/src/Common/Model/EditPayment.hs
+++ /dev/null
@@ -1,24 +0,0 @@
-module Common.Model.EditPayment
-  ( EditPayment(..)
-  ) where
-
-import           Data.Aeson             (FromJSON, ToJSON)
-import           Data.Text              (Text)
-import           Data.Time.Calendar     (Day)
-import           GHC.Generics           (Generic)
-
-import           Common.Model.Category  (CategoryId)
-import           Common.Model.Frequency (Frequency)
-import           Common.Model.Payment   (PaymentId)
-
-data EditPayment = EditPayment
-  { _editPayment_id        :: PaymentId
-  , _editPayment_name      :: Text
-  , _editPayment_cost      :: Int
-  , _editPayment_date      :: Day
-  , _editPayment_category  :: CategoryId
-  , _editPayment_frequency :: Frequency
-  } deriving (Show, Generic)
-
-instance FromJSON EditPayment
-instance ToJSON EditPayment
diff --git a/common/src/Common/Model/EditPaymentForm.hs b/common/src/Common/Model/EditPaymentForm.hs
new file mode 100644
index 0000000..168c9ff
--- /dev/null
+++ b/common/src/Common/Model/EditPaymentForm.hs
@@ -0,0 +1,23 @@
+module Common.Model.EditPaymentForm
+  ( EditPaymentForm(..)
+  ) where
+
+import           Data.Aeson             (FromJSON, ToJSON)
+import           Data.Text              (Text)
+import           GHC.Generics           (Generic)
+
+import           Common.Model.Category  (CategoryId)
+import           Common.Model.Frequency (Frequency)
+import           Common.Model.Payment   (PaymentId)
+
+data EditPaymentForm = EditPaymentForm
+  { _editPaymentForm_id        :: PaymentId
+  , _editPaymentForm_name      :: Text
+  , _editPaymentForm_cost      :: Text
+  , _editPaymentForm_date      :: Text
+  , _editPaymentForm_category  :: CategoryId
+  , _editPaymentForm_frequency :: Frequency
+  } deriving (Show, Generic)
+
+instance FromJSON EditPaymentForm
+instance ToJSON EditPaymentForm
diff --git a/common/src/Common/Validation/Payment.hs b/common/src/Common/Validation/Payment.hs
index b6c1d30..1bb00ce 100644
--- a/common/src/Common/Validation/Payment.hs
+++ b/common/src/Common/Validation/Payment.hs
@@ -2,20 +2,31 @@ module Common.Validation.Payment
   ( name
   , cost
   , date
+  , category
   ) where
 
 import           Data.Text                (Text)
 import           Data.Time.Calendar       (Day)
 import           Data.Validation          (Validation)
-import qualified Data.Validation          as Validation
+import qualified Data.Validation          as V
 
+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
 
 cost :: Text -> Validation Text Int
-cost input = Validation.bindValidation (Atomic.number input) Atomic.nonNullNumber
+cost input = V.bindValidation (Atomic.number input) Atomic.nonNullNumber
 
 date :: Text -> Validation Text Day
 date = Atomic.day
+
+category :: [CategoryId] -> CategoryId -> Validation Text CategoryId
+category cs c =
+  if elem c cs then
+    V.Success c
+  else
+    V.Failure $ Msg.get Msg.Form_InvalidCategory
diff --git a/server/server.cabal b/server/server.cabal
index 3c1c770..ea7ebed 100644
--- a/server/server.cabal
+++ b/server/server.cabal
@@ -50,6 +50,7 @@ Executable server
     , transformers
     , unordered-containers
     , uuid
+    , validation
     , wai
     , wai-extra
     , wai-middleware-static
@@ -57,6 +58,7 @@ Executable server
   other-modules:
     Conf
     Controller.Category
+    Controller.Helper
     Controller.Income
     Controller.Index
     Controller.Payment
@@ -90,6 +92,8 @@ Executable server
     Job.WeeklyReport
     Json
     LoginSession
+    Model.CreatePayment
+    Model.EditPayment
     Model.IncomeResource
     Model.Mail
     Model.PaymentResource
@@ -107,8 +111,7 @@ Executable server
     Secure
     SendMail
     Util.Time
-    Validation.Atomic
-    Validation.CreatePayment
+    Validation.Payment
     View.Mail.SignIn
     View.Mail.WeeklyReport
     View.Page
diff --git a/server/src/Controller/Helper.hs b/server/src/Controller/Helper.hs
new file mode 100644
index 0000000..fd0d2bb
--- /dev/null
+++ b/server/src/Controller/Helper.hs
@@ -0,0 +1,17 @@
+module Controller.Helper
+  ( jsonOrBadRequest
+  ) where
+
+import           Data.Aeson                (ToJSON)
+import           Data.Text                 (Text)
+import qualified Data.Text.Lazy            as LT
+import qualified Network.HTTP.Types.Status as Status
+import           Web.Scotty                (ActionM)
+import qualified Web.Scotty                as S
+
+jsonOrBadRequest :: forall a. (ToJSON a) => Either Text a -> ActionM ()
+jsonOrBadRequest (Left message) = do
+  S.status Status.badRequest400
+  S.text (LT.fromStrict message)
+jsonOrBadRequest (Right a) =
+  S.json a
diff --git a/server/src/Controller/Payment.hs b/server/src/Controller/Payment.hs
index 38c1c19..ba9d1ba 100644
--- a/server/src/Controller/Payment.hs
+++ b/server/src/Controller/Payment.hs
@@ -6,18 +6,25 @@ module Controller.Payment
   ) 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                (CreatePayment (..),
-                                              EditPayment (..), Payment (..),
-                                              PaymentId, SavedPayment (..),
-                                              User (..))
+import           Common.Model                (Category (..),
+                                              CreatePaymentForm (..),
+                                              EditPaymentForm (..),
+                                              Payment (..), PaymentId,
+                                              SavedPayment (..), User (..))
+import qualified Common.Msg                  as Msg
+import qualified Controller.Helper           as ControllerHelper
+import           Model.CreatePayment         (CreatePayment (..))
+import           Model.EditPayment           (EditPayment (..))
 import qualified Model.Query                 as Query
+import qualified Persistence.Category        as CategoryPersistence
 import qualified Persistence.Payment         as PaymentPersistence
 import qualified Persistence.PaymentCategory as PaymentCategoryPersistence
 import qualified Secure
-import qualified Validation.CreatePayment    as CreatePaymentValidation
+import qualified Validation.Payment          as PaymentValidation
 
 list :: ActionM ()
 list =
@@ -25,39 +32,39 @@ list =
     (liftIO . Query.run $ PaymentPersistence.listActive) >>= json
   )
 
-create :: CreatePayment -> ActionM ()
-create createPayment@(CreatePayment name cost date category frequency) =
+create :: CreatePaymentForm -> ActionM ()
+create form =
   Secure.loggedAction (\user ->
-    case CreatePaymentValidation.validate createPayment of
-      Nothing ->
-        (liftIO . Query.run $ do
+    (liftIO . Query.run $ do
+      cs <- map _category_id <$> CategoryPersistence.list
+      case PaymentValidation.createPayment cs form of
+        Success (CreatePayment name cost date category frequency) -> do
           pc <- PaymentCategoryPersistence.save name category
           p <- PaymentPersistence.create (_user_id user) name cost date frequency
-          return $ SavedPayment p pc
-        ) >>= json
-      Just validationError ->
-        do
-          status Status.badRequest400
-          json validationError
+          return . Right $ SavedPayment p pc
+        Failure validationError ->
+          return $ Left validationError
+    ) >>= ControllerHelper.jsonOrBadRequest
   )
 
-edit :: EditPayment -> ActionM ()
-edit (EditPayment paymentId name cost date category frequency) =
-  Secure.loggedAction (\user -> do
-    result <- liftIO . Query.run $ do
-      editedPayment <- PaymentPersistence.edit (_user_id user) paymentId name cost date frequency
-      case editedPayment of
-        Just (old, new) -> do
-          pc <- PaymentCategoryPersistence.save name category
-          PaymentCategoryPersistence.deleteIfUnused (_payment_name old)
-          return $ Just (new, pc)
-        Nothing ->
-          return Nothing
-    case result of
-      Just (p, pc) ->
-        json $ SavedPayment p pc
-      Nothing ->
-        status Status.badRequest400
+edit :: EditPaymentForm -> ActionM ()
+edit form =
+  Secure.loggedAction (\user ->
+    (liftIO . Query.run $ do
+      cs <- map _category_id <$> CategoryPersistence.list
+      case PaymentValidation.editPayment cs form of
+        Success (EditPayment paymentId name cost date category frequency) -> do
+          editedPayment <- PaymentPersistence.edit (_user_id user) paymentId name cost date frequency
+          case editedPayment of
+            Just (old, new) -> do
+              pc <- PaymentCategoryPersistence.save name category
+              PaymentCategoryPersistence.deleteIfUnused (_payment_name old)
+              return . Right $ SavedPayment new pc
+            Nothing ->
+              return . Left $ Msg.get Msg.Error_PaymentEdit
+        Failure validationError ->
+          return $ Left validationError
+    ) >>= ControllerHelper.jsonOrBadRequest
   )
 
 delete :: PaymentId -> ActionM ()
diff --git a/server/src/Model/CreatePayment.hs b/server/src/Model/CreatePayment.hs
new file mode 100644
index 0000000..b25d2a4
--- /dev/null
+++ b/server/src/Model/CreatePayment.hs
@@ -0,0 +1,16 @@
+module Model.CreatePayment
+  ( CreatePayment(..)
+  ) where
+
+import           Data.Text          (Text)
+import           Data.Time.Calendar (Day)
+
+import           Common.Model       (CategoryId, Frequency)
+
+data CreatePayment = CreatePayment
+  { _createPayment_name      :: Text
+  , _createPayment_cost      :: Int
+  , _createPayment_date      :: Day
+  , _createPayment_category  :: CategoryId
+  , _createPayment_frequency :: Frequency
+  } deriving (Show)
diff --git a/server/src/Model/EditPayment.hs b/server/src/Model/EditPayment.hs
new file mode 100644
index 0000000..ac4c906
--- /dev/null
+++ b/server/src/Model/EditPayment.hs
@@ -0,0 +1,17 @@
+module Model.EditPayment
+  ( EditPayment(..)
+  ) where
+
+import           Data.Text          (Text)
+import           Data.Time.Calendar (Day)
+
+import           Common.Model       (CategoryId, Frequency, PaymentId)
+
+data EditPayment = EditPayment
+  { _editPayment_id        :: PaymentId
+  , _editPayment_name      :: Text
+  , _editPayment_cost      :: Int
+  , _editPayment_date      :: Day
+  , _editPayment_category  :: CategoryId
+  , _editPayment_frequency :: Frequency
+  } deriving (Show)
diff --git a/server/src/Validation/Atomic.hs b/server/src/Validation/Atomic.hs
deleted file mode 100644
index 7a7351a..0000000
--- a/server/src/Validation/Atomic.hs
+++ /dev/null
@@ -1,32 +0,0 @@
-module Validation.Atomic
-  ( nonEmpty
-  , nonNullNumber
-  -- , number
-  ) where
-
-import           Data.Text  (Text)
-import qualified Data.Text  as T
-
-import qualified Common.Msg as Msg
-
-nonEmpty :: Text -> Maybe Text
-nonEmpty str =
-  if T.null str
-    then Just $ Msg.get Msg.Form_NonEmpty
-    else Nothing
-
-nonNullNumber :: Int -> Maybe Text
-nonNullNumber n =
-  if n == 0
-     then Just $ Msg.get Msg.Form_NonNullNumber
-     else Nothing
-
--- number :: (Int -> Bool) -> Text -> Maybe Int
--- number numberForm str =
---   case reads (T.unpack str) :: [(Int, String)] of
---     (num, _) : _ ->
---       if numberForm num
---         then Just num
---         else Nothing
---     _ ->
---       Nothing
diff --git a/server/src/Validation/CreatePayment.hs b/server/src/Validation/CreatePayment.hs
deleted file mode 100644
index fbcdb7c..0000000
--- a/server/src/Validation/CreatePayment.hs
+++ /dev/null
@@ -1,25 +0,0 @@
-module Validation.CreatePayment
-  ( validate
-  ) where
-
-import           Data.Maybe                 (catMaybes)
-
-import           Common.Model.CreatePayment (CreatePayment (..),
-                                             CreatePaymentError (..))
-import qualified Validation.Atomic          as Atomic
-
-validate :: CreatePayment -> Maybe CreatePaymentError
-validate p =
-  if not . null . catMaybes $ [ nameError, costError ]
-    then Just createPaymentError
-    else Nothing
-  where
-    nameError = Atomic.nonEmpty . _createPayment_name $ p
-    costError = Atomic.nonNullNumber . _createPayment_cost $ p
-    createPaymentError = CreatePaymentError
-      { _createPaymentError_name      = nameError
-      , _createPaymentError_cost      = costError
-      , _createPaymentError_date      = Nothing
-      , _createPaymentError_category  = Nothing
-      , _createPaymentError_frequency = Nothing
-      }
diff --git a/server/src/Validation/Payment.hs b/server/src/Validation/Payment.hs
new file mode 100644
index 0000000..20e370e
--- /dev/null
+++ b/server/src/Validation/Payment.hs
@@ -0,0 +1,33 @@
+module Validation.Payment
+  ( createPayment
+  , editPayment
+  ) where
+
+import           Data.Text                 (Text)
+import           Data.Validation           (Validation)
+import qualified Data.Validation           as V
+
+import           Common.Model              (CategoryId, CreatePaymentForm (..),
+                                            EditPaymentForm (..))
+import qualified Common.Validation.Payment as PaymentValidation
+import           Model.CreatePayment       (CreatePayment (..))
+import           Model.EditPayment         (EditPayment (..))
+
+createPayment :: [CategoryId] -> CreatePaymentForm -> Validation Text CreatePayment
+createPayment categories form =
+  CreatePayment
+    <$> PaymentValidation.name (_createPaymentForm_name form)
+    <*> PaymentValidation.cost (_createPaymentForm_cost form)
+    <*> PaymentValidation.date (_createPaymentForm_date form)
+    <*> PaymentValidation.category categories (_createPaymentForm_category form)
+    <*> V.Success (_createPaymentForm_frequency form)
+
+editPayment :: [CategoryId] -> EditPaymentForm -> Validation Text EditPayment
+editPayment categories form =
+  EditPayment
+    <$> V.Success (_editPaymentForm_id form)
+    <*> PaymentValidation.name (_editPaymentForm_name form)
+    <*> PaymentValidation.cost (_editPaymentForm_cost form)
+    <*> PaymentValidation.date (_editPaymentForm_date form)
+    <*> PaymentValidation.category categories (_editPaymentForm_category form)
+    <*> V.Success (_editPaymentForm_frequency form)
-- 
cgit v1.2.3