7 files changed, 67 insertions, 28 deletions
diff --git a/src/server/Controller/Payment.hs b/src/server/Controller/Payment.hs
index d2a9258..e94b300 100644
--- a/src/server/Controller/Payment.hs
+++ b/src/server/Controller/Payment.hs
@@ -10,23 +10,24 @@ module Controller.Payment
 
 import Web.Scotty
 
-import Network.HTTP.Types.Status (ok200)
+import Network.HTTP.Types.Status (ok200, badRequest400)
 
 import Database.Persist
 
 import Control.Monad.IO.Class (liftIO)
 
 import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Aeson.Types as Json
 
 import qualified Secure
 
-import Json (jsonError)
+import Json (jsonObject, jsonError)
 
 import Model.Database
 import qualified Model.Payment as P
 import Model.Frequency
 import Model.Json.Number
-import qualified Model.Json.PaymentId as JP
 import Model.Message
 import Model.Message.Key (Key(PaymentNotDeleted))
 
@@ -42,11 +43,16 @@ getMonthlyPayments =
     (liftIO $ runDb (P.getUserMonthlyPayments (entityKey user))) >>= json
   )
 
-createPayment :: Text -> Int -> Frequency -> ActionM ()
+createPayment :: Text -> Text -> Frequency -> ActionM ()
 createPayment name cost frequency =
   Secure.loggedAction (\user -> do
-    paymentId <- liftIO . runDb $ P.createPayment (entityKey user) name cost frequency
-    json (JP.PaymentId paymentId)
+    creationResult <- liftIO . runDb $ P.createPayment (entityKey user) name cost frequency
+    case creationResult of
+      Left errors -> do
+        status badRequest400
+        jsonObject . map (\(a, b) -> (a, Json.String . T.pack . show $ b)) $ errors
+      Right paymentId ->
+        jsonObject [("id", Json.Number . fromIntegral . keyToInt64 $ paymentId)]
   )
 
 deletePayment :: Text -> ActionM ()
diff --git a/src/server/Design/LoggedIn/Table.hs b/src/server/Design/LoggedIn/Table.hs
index d9fc318..e5ed4bf 100644
--- a/src/server/Design/LoggedIn/Table.hs
+++ b/src/server/Design/LoggedIn/Table.hs
@@ -91,6 +91,7 @@ tableDesign =
         textAlign (alignSide sideCenter)
         button ? do
           defaultButton C.red C.white (px rowHeightPx) focusLighten
+          borderRadius (px 0) (px 0) (px 0) (px 0)
           position absolute
           top (px 0)
           right (px 0)
diff --git a/src/server/Main.hs b/src/server/Main.hs
index 9f21873..e5d8cca 100644
--- a/src/server/Main.hs
+++ b/src/server/Main.hs
@@ -61,7 +61,7 @@ main = do
 
         post "/payment/add" $ do
           name <- param "name" :: ActionM Text
-          cost <- param "cost" :: ActionM Int
+          cost <- param "cost" :: ActionM Text
           frequency <- param "frequency" :: ActionM Frequency
           createPayment name cost frequency
 
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
diff --git a/src/server/Validation.hs b/src/server/Validation.hs
new file mode 100644
index 0000000..9035be7
--- /dev/null
+++ b/src/server/Validation.hs
@@ -0,0 +1,23 @@
+module Validation
+  ( nonEmpty
+  , number
+  ) where
+
+import Data.Text (Text)
+import qualified Data.Text as T
+
+nonEmpty :: a -> Text -> Either a Text
+nonEmpty x str =
+  if T.null str
+   then Left x
+   else Right str
+
+number :: x -> (Int -> Bool) -> Text -> Either x Int
+number x numberForm str =
+  case reads (T.unpack str) :: [(Int, String)] of
+    (number, _) : _ ->
+      if numberForm number
+        then Right number
+        else Left x
+    _ ->
+      Left x