aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoris2019-10-09 23:16:00 +0200
committerJoris2019-10-09 23:16:04 +0200
commit7529a18ff0ac443e7f9764b5e2d0f57a5d3a850b (patch)
tree3d5cfc1f2318c2d4f889ee70764929f1a96e4c41
parente5ac82f4808e974dec5f19fc6f059efaa5214022 (diff)
Use common payment validation in the backend
Remove deprecated backend validation
-rw-r--r--ISSUES.md4
-rw-r--r--client/src/Component/Select.hs11
-rw-r--r--client/src/View/Payment/Add.hs35
-rw-r--r--client/src/View/Payment/Clone.hs35
-rw-r--r--client/src/View/Payment/Edit.hs27
-rw-r--r--client/src/View/Payment/Form.hs12
-rw-r--r--client/src/View/Payment/Header.hs3
-rw-r--r--common/common.cabal4
-rw-r--r--common/src/Common/Model.hs38
-rw-r--r--common/src/Common/Model/CreatePayment.hs34
-rw-r--r--common/src/Common/Model/CreatePaymentForm.hs21
-rw-r--r--common/src/Common/Model/EditPayment.hs24
-rw-r--r--common/src/Common/Model/EditPaymentForm.hs23
-rw-r--r--common/src/Common/Validation/Payment.hs15
-rw-r--r--server/server.cabal7
-rw-r--r--server/src/Controller/Helper.hs17
-rw-r--r--server/src/Controller/Payment.hs73
-rw-r--r--server/src/Model/CreatePayment.hs16
-rw-r--r--server/src/Model/EditPayment.hs17
-rw-r--r--server/src/Validation/Atomic.hs32
-rw-r--r--server/src/Validation/CreatePayment.hs25
-rw-r--r--server/src/Validation/Payment.hs33
22 files changed, 264 insertions, 242 deletions
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)