Delete payment

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
+      }