Validate add payment server side

3 files changed, 30 insertions, 21 deletions

diff --git a/src/server/Model/Database.hs b/src/server/Model/Database.hs
index 67cc8b3..a98e69a 100644
--- a/src/server/Model/Database.hs
+++ b/src/server/Model/Database.hs
@@ -69,3 +69,6 @@ runMigrations = runDb $ runMigration migrateAll
 
 textToKey :: (ToBackendKey SqlBackend a) => Text -> Key a
 textToKey text = toSqlKey (read (unpack text) :: Int64)
+
+keyToInt64 :: (ToBackendKey SqlBackend a) => Key a -> Int64
+keyToInt64 = fromSqlKey
diff --git a/src/server/Model/Json/PaymentId.hs b/src/server/Model/Json/PaymentId.hs
deleted file mode 100644
index 3cbeb3c..0000000
--- a/src/server/Model/Json/PaymentId.hs
+++ /dev/null
@@ -1,17 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module Model.Json.PaymentId
-  ( PaymentId(..)
-  ) where
-
-import Data.Aeson
-import GHC.Generics
-
-import qualified Model.Database as D
-
-data PaymentId = PaymentId
-  { id :: D.PaymentId
-  } deriving (Show, Generic)
-
-instance FromJSON PaymentId
-instance ToJSON PaymentId
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