From 40b4994797a797b1fa86cafda789a5c488730c6d Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 28 Oct 2018 17:57:58 +0100 Subject: Delete payment --- server/src/Controller/Payment.hs | 17 ++++++++++++----- server/src/Design/Modal.hs | 9 +++++++-- server/src/Design/View/Payment.hs | 2 -- server/src/Design/View/Payment/Delete.hs | 32 ++++++++++++++++++++++++++++++++ server/src/Main.hs | 6 +++--- server/src/Validation.hs | 23 ----------------------- server/src/Validation/Atomic.hs | 32 ++++++++++++++++++++++++++++++++ server/src/Validation/CreatePayment.hs | 25 +++++++++++++++++++++++++ 8 files changed, 111 insertions(+), 35 deletions(-) create mode 100644 server/src/Design/View/Payment/Delete.hs delete mode 100644 server/src/Validation.hs create mode 100644 server/src/Validation/Atomic.hs create mode 100644 server/src/Validation/CreatePayment.hs (limited to 'server/src') 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 + } -- cgit v1.2.3