aboutsummaryrefslogtreecommitdiff
path: root/server
diff options
context:
space:
mode:
Diffstat (limited to 'server')
-rw-r--r--server/server.cabal5
-rw-r--r--server/src/Controller/Payment.hs17
-rw-r--r--server/src/Design/Modal.hs9
-rw-r--r--server/src/Design/View/Payment.hs2
-rw-r--r--server/src/Design/View/Payment/Delete.hs32
-rw-r--r--server/src/Main.hs6
-rw-r--r--server/src/Validation.hs23
-rw-r--r--server/src/Validation/Atomic.hs32
-rw-r--r--server/src/Validation/CreatePayment.hs25
9 files changed, 114 insertions, 37 deletions
diff --git a/server/server.cabal b/server/server.cabal
index 2bfd18d..2c6bef1 100644
--- a/server/server.cabal
+++ b/server/server.cabal
@@ -21,7 +21,7 @@ Executable server
Build-depends:
aeson
- , base >=4.9 && <4.11
+ , base >=4.9 && <5
, base64-bytestring
, blaze-builder
, blaze-html
@@ -103,7 +103,8 @@ Executable server
Secure
SendMail
Util.Time
- Validation
+ Validation.Atomic
+ Validation.CreatePayment
View.Mail.SignIn
View.Mail.WeeklyReport
View.Page
diff --git a/server/src/Controller/Payment.hs b/server/src/Controller/Payment.hs
index e1936f0..4edbf6a 100644
--- a/server/src/Controller/Payment.hs
+++ b/server/src/Controller/Payment.hs
@@ -18,6 +18,7 @@ import qualified Model.Query as Query
import qualified Persistence.Payment as PaymentPersistence
import qualified Persistence.PaymentCategory as PaymentCategoryPersistence
import qualified Secure
+import qualified Validation.CreatePayment as CreatePaymentValidation
list :: ActionM ()
list =
@@ -26,12 +27,18 @@ list =
)
create :: CreatePayment -> ActionM ()
-create (CreatePayment name cost date category frequency) =
+create createPayment@(CreatePayment name cost date category frequency) =
Secure.loggedAction (\user ->
- (liftIO . Query.run $ do
- PaymentCategoryPersistence.save name category
- PaymentPersistence.create (_user_id user) name cost date frequency
- ) >>= Json.jsonId
+ case CreatePaymentValidation.validate createPayment of
+ Nothing ->
+ (liftIO . Query.run $ do
+ PaymentCategoryPersistence.save name category
+ PaymentPersistence.create (_user_id user) name cost date frequency
+ ) >>= Json.jsonId
+ Just validationError ->
+ do
+ status Status.badRequest400
+ json validationError
)
editOwn :: EditPayment -> ActionM ()
diff --git a/server/src/Design/Modal.hs b/server/src/Design/Modal.hs
index ce427c0..2677fd8 100644
--- a/server/src/Design/Modal.hs
+++ b/server/src/Design/Modal.hs
@@ -2,9 +2,11 @@ module Design.Modal
( design
) where
-import Data.Monoid ((<>))
-
import Clay
+import Data.Monoid ((<>))
+
+import qualified Design.View.Payment.Add as Add
+import qualified Design.View.Payment.Delete as Delete
design :: Css
design = do
@@ -31,6 +33,9 @@ design = do
sym borderRadius (px 5)
boxShadow (px 0) (px 0) (px 15) (rgba 0 0 0 0.5)
+ ".add" ? Add.design
+ ".delete" ? Delete.design
+
".paymentModal" & do
".radioGroup" ? ".title" ? display none
".selectInput" ? do
diff --git a/server/src/Design/View/Payment.hs b/server/src/Design/View/Payment.hs
index 2102ff8..0d59fa0 100644
--- a/server/src/Design/View/Payment.hs
+++ b/server/src/Design/View/Payment.hs
@@ -4,7 +4,6 @@ module Design.View.Payment
import Clay
-import qualified Design.View.Payment.Add as Add
import qualified Design.View.Payment.Header as Header
import qualified Design.View.Payment.Pages as Pages
import qualified Design.View.Payment.Table as Table
@@ -12,6 +11,5 @@ import qualified Design.View.Payment.Table as Table
design :: Css
design = do
".header" ? Header.design
- ".add" ? Add.design
".table" ? Table.design
".pages" ? Pages.design
diff --git a/server/src/Design/View/Payment/Delete.hs b/server/src/Design/View/Payment/Delete.hs
new file mode 100644
index 0000000..5597f5b
--- /dev/null
+++ b/server/src/Design/View/Payment/Delete.hs
@@ -0,0 +1,32 @@
+module Design.View.Payment.Delete
+ ( design
+ ) where
+
+import Clay
+
+import qualified Design.Color as Color
+import qualified Design.Constants as Constants
+import qualified Design.Helper as Helper
+
+design :: Css
+design = do
+ ".deleteHeader" ? do
+ backgroundColor Color.chestnutRose
+ fontSize (px 18)
+ color Color.white
+ sym padding (px 20)
+ textAlign (alignSide sideCenter)
+ borderRadius (px 5) (px 5) (px 0) (px 0)
+
+ ".deleteContent" ? do
+ sym padding (px 20)
+
+ ".buttons" ? do
+ display flex
+ justifyContent spaceAround
+ marginTop (em 1.5)
+
+ ".confirm" ?
+ Helper.button Color.chestnutRose Color.white (px Constants.inputHeight) Constants.focusLighten
+ ".undo" ?
+ Helper.button Color.silver Color.white (px Constants.inputHeight) Constants.focusLighten
diff --git a/server/src/Main.hs b/server/src/Main.hs
index e298a06..745071c 100644
--- a/server/src/Main.hs
+++ b/server/src/Main.hs
@@ -37,7 +37,7 @@ main = do
S.put "/payment" $
S.jsonData >>= Payment.editOwn
- S.delete "/payment" $ do
+ S.delete "/payment/:id" $ do
paymentId <- S.param "id"
Payment.deleteOwn paymentId
@@ -47,7 +47,7 @@ main = do
S.put "/income" $
S.jsonData >>= Income.editOwn
- S.delete "/income" $ do
+ S.delete "/income/:id" $ do
incomeId <- S.param "id"
Income.deleteOwn incomeId
@@ -57,6 +57,6 @@ main = do
S.put "/category" $
S.jsonData >>= Category.edit
- S.delete "/category" $ do
+ S.delete "/category/:id" $ do
categoryId <- S.param "id"
Category.delete categoryId
diff --git a/server/src/Validation.hs b/server/src/Validation.hs
deleted file mode 100644
index fd739cd..0000000
--- a/server/src/Validation.hs
+++ /dev/null
@@ -1,23 +0,0 @@
-module Validation
- ( nonEmpty
- , number
- ) where
-
-import Data.Text (Text)
-import qualified Data.Text as T
-
-nonEmpty :: Text -> Maybe Text
-nonEmpty str =
- if T.null str
- then Nothing
- else Just str
-
-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/Atomic.hs b/server/src/Validation/Atomic.hs
new file mode 100644
index 0000000..d15ad49
--- /dev/null
+++ b/server/src/Validation/Atomic.hs
@@ -0,0 +1,32 @@
+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
new file mode 100644
index 0000000..fbcdb7c
--- /dev/null
+++ b/server/src/Validation/CreatePayment.hs
@@ -0,0 +1,25 @@
+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
+ }
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 18:21:35 +0000