aboutsummaryrefslogtreecommitdiff
path: root/src/server/Model
diff options
context:
space:
mode:
Diffstat (limited to 'src/server/Model')
-rw-r--r--src/server/Model/Database.hs3
-rw-r--r--src/server/Model/Json/PaymentId.hs17
-rw-r--r--src/server/Model/Payment.hs31
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