aboutsummaryrefslogtreecommitdiff
path: root/src/server
diff options
context:
space:
mode:
Diffstat (limited to 'src/server')
-rw-r--r--src/server/Controller/Payment.hs9
-rw-r--r--src/server/Design/Header.hs5
-rw-r--r--src/server/Main.hs2
-rw-r--r--src/server/Model/Frequency.hs9
-rw-r--r--src/server/Model/Json/Payment.hs2
-rw-r--r--src/server/Model/Payment.hs23
6 files changed, 20 insertions, 30 deletions
diff --git a/src/server/Controller/Payment.hs b/src/server/Controller/Payment.hs
index a9d1acb..204794a 100644
--- a/src/server/Controller/Payment.hs
+++ b/src/server/Controller/Payment.hs
@@ -2,7 +2,6 @@
module Controller.Payment
( getPayments
- , getMonthlyPayments
, createPayment
, deletePayment
) where
@@ -32,13 +31,7 @@ import Model.Message.Key (Key(PaymentNotDeleted))
getPayments :: ActionM ()
getPayments =
Secure.loggedAction (\_ -> do
- (liftIO $ runDb P.getPunctualPayments) >>= json
- )
-
-getMonthlyPayments :: ActionM ()
-getMonthlyPayments =
- Secure.loggedAction (\user -> do
- (liftIO $ runDb (P.getUserMonthlyPayments (entityKey user))) >>= json
+ (liftIO $ runDb P.getPayments) >>= json
)
createPayment :: Text -> Text -> Frequency -> ActionM ()
diff --git a/src/server/Design/Header.hs b/src/server/Design/Header.hs
index e44bce7..c4f9332 100644
--- a/src/server/Design/Header.hs
+++ b/src/server/Design/Header.hs
@@ -49,8 +49,5 @@ headerDesign =
".user" <> ".icon" ? do
paddingLeft headerPadding
paddingRight headerPadding
- borderLeft solid (px 1) darkenedRed
- ".icon" ? do
- fontSize iconFontSize
- borderRight solid (px 1) darkenedRed
+ ".icon" ? fontSize iconFontSize
diff --git a/src/server/Main.hs b/src/server/Main.hs
index 1cb324e..9734781 100644
--- a/src/server/Main.hs
+++ b/src/server/Main.hs
@@ -76,8 +76,6 @@ api conf = do
get "/api/payments" getPayments
- get "/api/monthlyPayments" getMonthlyPayments
-
post "/api/payment/add" $ do
name <- param "name" :: ActionM Text
cost <- param "cost" :: ActionM Text
diff --git a/src/server/Model/Frequency.hs b/src/server/Model/Frequency.hs
index 2b747b7..a6ba55c 100644
--- a/src/server/Model/Frequency.hs
+++ b/src/server/Model/Frequency.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
@@ -5,15 +6,21 @@ module Model.Frequency
( Frequency(..)
) where
+import GHC.Generics
+
import Web.Scotty
import Database.Persist.TH
+import Data.Aeson
+
data Frequency =
Punctual
| Monthly
- deriving (Eq, Show, Read)
+ deriving (Eq, Show, Read, Generic)
derivePersistField "Frequency"
instance Parsable Frequency where parseParam = readEither
+instance FromJSON Frequency
+instance ToJSON Frequency
diff --git a/src/server/Model/Json/Payment.hs b/src/server/Model/Json/Payment.hs
index 8923c13..7f4de15 100644
--- a/src/server/Model/Json/Payment.hs
+++ b/src/server/Model/Json/Payment.hs
@@ -11,6 +11,7 @@ import Data.Text (Text)
import Data.Aeson
import Model.Database (PaymentId, UserId)
+import Model.Frequency
data Payment = Payment
{ id :: PaymentId
@@ -18,6 +19,7 @@ data Payment = Payment
, name :: Text
, cost :: Int
, userId :: UserId
+ , frequency :: Frequency
} deriving (Show, Generic)
instance FromJSON Payment
diff --git a/src/server/Model/Payment.hs b/src/server/Model/Payment.hs
index 5c7d940..47397ff 100644
--- a/src/server/Model/Payment.hs
+++ b/src/server/Model/Payment.hs
@@ -1,8 +1,7 @@
{-# LANGUAGE OverloadedStrings #-}
module Model.Payment
- ( getPunctualPayments
- , getUserMonthlyPayments
+ ( getPayments
, getMonthlyPayments
, createPayment
, deleteOwnPayment
@@ -15,7 +14,6 @@ import Data.Either (lefts)
import Control.Monad.IO.Class (liftIO)
import Database.Persist
-import qualified Database.Persist as P
import qualified Validation
@@ -24,23 +22,17 @@ import Model.Frequency
import qualified Model.Json.Payment as P
import qualified Model.Message.Key as K
-getPunctualPayments :: Persist [P.Payment]
-getPunctualPayments =
+getPayments :: Persist [P.Payment]
+getPayments =
map getJsonPayment <$> selectList
- [ PaymentDeletedAt P.==. Nothing
- , PaymentFrequency P.==. Punctual
- ]
+ [ PaymentDeletedAt ==. Nothing ]
[ Desc PaymentCreation ]
-getUserMonthlyPayments :: UserId -> Persist [P.Payment]
-getUserMonthlyPayments userId =
- filter ((==) userId . P.userId) . map getJsonPayment <$> getMonthlyPayments
-
getMonthlyPayments :: Persist [Entity Payment]
getMonthlyPayments =
selectList
- [ PaymentDeletedAt P.==. Nothing
- , PaymentFrequency P.==. Monthly
+ [ PaymentDeletedAt ==. Nothing
+ , PaymentFrequency ==. Monthly
]
[ Desc PaymentName ]
@@ -53,6 +45,7 @@ getJsonPayment paymentEntity =
, P.name = paymentName payment
, P.cost = paymentCost payment
, P.userId = paymentUserId payment
+ , P.frequency = paymentFrequency payment
}
createPayment :: UserId -> Text -> Text -> Frequency -> Persist (Either [(Text, K.Key)] PaymentId)
@@ -84,7 +77,7 @@ deleteOwnPayment user paymentId = do
if paymentUserId payment == entityKey user
then do
now <- liftIO getCurrentTime
- P.update paymentId [PaymentDeletedAt P.=. Just now]
+ update paymentId [PaymentDeletedAt =. Just now]
return True
else
return False