aboutsummaryrefslogtreecommitdiff
path: root/src/server
diff options
context:
space:
mode:
Diffstat (limited to 'src/server')
-rw-r--r--src/server/Controller/Payment.hs26
-rw-r--r--src/server/Design/Form.hs2
-rw-r--r--src/server/Design/LoggedIn/Home/Table.hs6
-rw-r--r--src/server/Main.hs2
-rw-r--r--src/server/Model/Database.hs5
-rw-r--r--src/server/Model/Json/CreatePayment.hs4
-rw-r--r--src/server/Model/Json/EditPayment.hs24
-rw-r--r--src/server/Model/Message/Key.hs2
-rw-r--r--src/server/Model/Message/Translations.hs10
-rw-r--r--src/server/Model/Payment.hs34
10 files changed, 92 insertions, 23 deletions
diff --git a/src/server/Controller/Payment.hs b/src/server/Controller/Payment.hs
index 55edea5..96ac469 100644
--- a/src/server/Controller/Payment.hs
+++ b/src/server/Controller/Payment.hs
@@ -3,6 +3,7 @@
module Controller.Payment
( list
, create
+ , editOwn
, deleteOwn
) where
@@ -15,7 +16,6 @@ import Database.Persist
import Control.Monad.IO.Class (liftIO)
import Data.Text (Text)
-import qualified Data.Text.Lazy as TL
import qualified Secure
@@ -23,8 +23,8 @@ import Json (jsonId)
import Model.Database
import qualified Model.Payment as Payment
-import Model.Message.Key (Key(PaymentNotDeleted))
import qualified Model.Json.CreatePayment as Json
+import qualified Model.Json.EditPayment as Json
list :: ActionM ()
list =
@@ -33,19 +33,25 @@ list =
)
create :: Json.CreatePayment -> ActionM ()
-create (Json.CreatePayment date name cost frequency) =
+create (Json.CreatePayment name cost date frequency) =
Secure.loggedAction (\user ->
- (liftIO . runDb $ Payment.create (entityKey user) date name cost frequency) >>= jsonId
+ (liftIO . runDb $ Payment.create (entityKey user) name cost date frequency) >>= jsonId
+ )
+
+editOwn :: Json.EditPayment -> ActionM ()
+editOwn (Json.EditPayment paymentId name cost date frequency) =
+ Secure.loggedAction (\user -> do
+ updated <- liftIO . runDb $ Payment.editOwn (entityKey user) paymentId name cost date frequency
+ if updated
+ then status ok200
+ else status badRequest400
)
deleteOwn :: Text -> ActionM ()
deleteOwn paymentId =
Secure.loggedAction (\user -> do
- deleted <- liftIO . runDb $ Payment.deleteOwn user (textToKey paymentId)
+ deleted <- liftIO . runDb $ Payment.deleteOwn (entityKey user) (textToKey paymentId)
if deleted
- then
- status ok200
- else do
- status badRequest400
- text . TL.pack . show $ PaymentNotDeleted
+ then status ok200
+ else status badRequest400
)
diff --git a/src/server/Design/Form.hs b/src/server/Design/Form.hs
index 612759b..caee8ff 100644
--- a/src/server/Design/Form.hs
+++ b/src/server/Design/Form.hs
@@ -51,6 +51,8 @@ design = do
right (px 0)
top (px 27)
zIndex inputZIndex
+ hover & "svg path" ? do
+ "fill" -: "rgb(220, 220, 220)"
(input # ".filled" |+ label) <> (input # focus |+ label) ? do
top (px 0)
diff --git a/src/server/Design/LoggedIn/Home/Table.hs b/src/server/Design/LoggedIn/Home/Table.hs
index 23b924f..3f55207 100644
--- a/src/server/Design/LoggedIn/Home/Table.hs
+++ b/src/server/Design/LoggedIn/Home/Table.hs
@@ -45,9 +45,9 @@ design = do
display tableCell
position relative
verticalAlign middle
- ".category" & width (pct 37)
+ ".category" & width (pct 36)
".cost" & do
- width (pct 17)
+ width (pct 15)
".refund" & color Color.mossGreen
".user" & width (pct 20)
".date" & do
@@ -63,4 +63,4 @@ design = do
width (pct 3)
textAlign (alignSide sideCenter)
button # hover ? "svg path" ? do
- "fill" -: "rgb(227, 112, 106)"
+ "fill" -: "rgb(237, 122, 116)"
diff --git a/src/server/Main.hs b/src/server/Main.hs
index 72e8675..19d78b3 100644
--- a/src/server/Main.hs
+++ b/src/server/Main.hs
@@ -54,6 +54,8 @@ main = do
post "/payment" $ jsonData >>= Payment.create
+ put "/payment" $ jsonData >>= Payment.editOwn
+
delete "/payment" $ do
paymentId <- param "id" :: ActionM Text
Payment.deleteOwn paymentId
diff --git a/src/server/Model/Database.hs b/src/server/Model/Database.hs
index 7e67f9a..4526fc5 100644
--- a/src/server/Model/Database.hs
+++ b/src/server/Model/Database.hs
@@ -35,12 +35,13 @@ User
deriving Show
Payment
userId UserId
- date Day
name Text
cost Int
+ date Day
+ frequency Frequency
createdAt UTCTime
+ editedAt UTCTime Maybe
deletedAt UTCTime Maybe
- frequency Frequency
deriving Show
SignIn
token Text
diff --git a/src/server/Model/Json/CreatePayment.hs b/src/server/Model/Json/CreatePayment.hs
index f117daf..4ba9e1a 100644
--- a/src/server/Model/Json/CreatePayment.hs
+++ b/src/server/Model/Json/CreatePayment.hs
@@ -13,9 +13,9 @@ import Data.Text (Text)
import Model.Frequency (Frequency)
data CreatePayment = CreatePayment
- { date :: Day
- , name :: Text
+ { name :: Text
, cost :: Int
+ , date :: Day
, frequency :: Frequency
} deriving (Show, Generic)
diff --git a/src/server/Model/Json/EditPayment.hs b/src/server/Model/Json/EditPayment.hs
new file mode 100644
index 0000000..4e91000
--- /dev/null
+++ b/src/server/Model/Json/EditPayment.hs
@@ -0,0 +1,24 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+module Model.Json.EditPayment
+ ( EditPayment(..)
+ ) where
+
+import GHC.Generics
+
+import Data.Aeson
+import Data.Time.Calendar (Day)
+import Data.Text (Text)
+
+import Model.Frequency (Frequency)
+import Model.Database (PaymentId)
+
+data EditPayment = EditPayment
+ { id :: PaymentId
+ , name :: Text
+ , cost :: Int
+ , date :: Day
+ , frequency :: Frequency
+ } deriving (Show, Generic)
+
+instance FromJSON EditPayment
diff --git a/src/server/Model/Message/Key.hs b/src/server/Model/Message/Key.hs
index 84ff486..b60067c 100644
--- a/src/server/Model/Message/Key.hs
+++ b/src/server/Model/Message/Key.hs
@@ -63,6 +63,8 @@ data Key =
| Frequency
| InvalidFrequency
| AddPayment
+ | ClonePayment
+ | EditPayment
| PaymentNotDeleted
| Punctual
| Monthly
diff --git a/src/server/Model/Message/Translations.hs b/src/server/Model/Message/Translations.hs
index a29b84e..3c92601 100644
--- a/src/server/Model/Message/Translations.hs
+++ b/src/server/Model/Message/Translations.hs
@@ -245,6 +245,16 @@ m l AddPayment =
English -> "Add a payment"
French -> "Ajouter un paiement"
+m l ClonePayment =
+ case l of
+ English -> "Clone a payment"
+ French -> "Cloner un paiement"
+
+m l EditPayment =
+ case l of
+ English -> "Edit a payment"
+ French -> "Modifier un paiement"
+
m l PaymentNotDeleted =
case l of
English -> "The payment could not have been deleted."
diff --git a/src/server/Model/Payment.hs b/src/server/Model/Payment.hs
index 51ca152..0d5e188 100644
--- a/src/server/Model/Payment.hs
+++ b/src/server/Model/Payment.hs
@@ -4,6 +4,7 @@ module Model.Payment
( list
, listMonthly
, create
+ , editOwn
, deleteOwn
) where
@@ -45,17 +46,38 @@ getJsonPayment paymentEntity =
, P.frequency = paymentFrequency payment
}
-create :: UserId -> Day -> Text -> Int -> Frequency -> Persist PaymentId
-create userId date name cost frequency = do
+create :: UserId -> Text -> Int -> Day -> Frequency -> Persist PaymentId
+create userId name cost date frequency = do
now <- liftIO getCurrentTime
- insert (Payment userId date name cost now Nothing frequency)
+ insert (Payment userId name cost date frequency now Nothing Nothing)
-deleteOwn :: Entity User -> PaymentId -> Persist Bool
-deleteOwn user paymentId = do
+editOwn :: UserId -> PaymentId -> Text -> Int -> Day -> Frequency -> Persist Bool
+editOwn userId paymentId name cost date frequency = do
mbPayment <- get paymentId
case mbPayment of
Just payment ->
- if paymentUserId payment == entityKey user
+ if paymentUserId payment == userId
+ then do
+ now <- liftIO getCurrentTime
+ update paymentId
+ [ PaymentEditedAt =. Just now
+ , PaymentName =. name
+ , PaymentCost =. cost
+ , PaymentDate =. date
+ , PaymentFrequency =. frequency
+ ]
+ return True
+ else
+ return False
+ Nothing ->
+ return False
+
+deleteOwn :: UserId -> PaymentId -> Persist Bool
+deleteOwn userId paymentId = do
+ mbPayment <- get paymentId
+ case mbPayment of
+ Just payment ->
+ if paymentUserId payment == userId
then do
now <- liftIO getCurrentTime
update paymentId [PaymentDeletedAt =. Just now]
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 21:51:14 +0000