From d9df5c3fcffe12aac239b58ccf2fd82c19c3be62 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 3 Jan 2016 23:37:14 +0100 Subject: Validate add payment server side --- src/server/Model/Payment.hs | 31 +++++++++++++++++++++++++++---- 1 file changed, 27 insertions(+), 4 deletions(-) (limited to 'src/server/Model/Payment.hs') diff --git a/src/server/Model/Payment.hs b/src/server/Model/Payment.hs index de4a759..404b143 100644 --- a/src/server/Model/Payment.hs +++ b/src/server/Model/Payment.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE OverloadedStrings #-} + module Model.Payment ( getPunctualPayments , getUserMonthlyPayments @@ -8,16 +10,21 @@ module Model.Payment ) where import Data.Text (Text) +import qualified Data.Text as T import Data.Time.Clock (getCurrentTime) +import Data.Either (lefts) import Control.Monad.IO.Class (liftIO) import Database.Persist import qualified Database.Persist as P +import qualified Validation + import Model.Database import Model.Frequency import qualified Model.Json.Payment as P +import qualified Model.Message.Key as K getPunctualPayments :: Persist [P.Payment] getPunctualPayments = @@ -50,10 +57,26 @@ getJsonPayment paymentEntity = , P.userId = paymentUserId payment } -createPayment :: UserId -> Text -> Int -> Frequency -> Persist PaymentId -createPayment userId name cost frequency = do - now <- liftIO getCurrentTime - insert $ Payment userId now name cost Nothing frequency +createPayment :: UserId -> Text -> Text -> Frequency -> Persist (Either [(Text, K.Key)] PaymentId) +createPayment userId name cost frequency = + case validatePayment name cost of + Left err -> + return . Left $ err + Right (validatedName, validatedCost) -> do + now <- liftIO getCurrentTime + Right <$> insert (Payment userId now validatedName validatedCost Nothing frequency) + +validatePayment :: Text -> Text -> Either [(Text, K.Key)] (Text, Int) +validatePayment name cost = + let eitherName = Validation.nonEmpty K.CategoryRequired name + eitherCost = Validation.nonEmpty K.CostRequired cost >>= Validation.number K.CostRequired (/= 0) + in case (eitherName, eitherCost) of + (Right validatedName, Right validatedCost) -> + Right (validatedName, validatedCost) + _ -> + let nameErrors = map (\x -> ("name", x)) $ lefts [eitherName] + costErrors = map (\x -> ("cost", x)) $ lefts [eitherCost] + in Left (nameErrors ++ costErrors) deleteOwnPayment :: Entity User -> PaymentId -> Persist Bool deleteOwnPayment user paymentId = do -- cgit v1.2.3