aboutsummaryrefslogtreecommitdiff
path: root/src/server
diff options
context:
space:
mode:
Diffstat (limited to 'src/server')
-rw-r--r--src/server/Controller/Payment.hs8
-rw-r--r--src/server/Main.hs3
-rw-r--r--src/server/Model/Json/Number.hs15
-rw-r--r--src/server/Model/Message/Translations.hs2
-rw-r--r--src/server/Model/Payment.hs9
5 files changed, 36 insertions, 1 deletions
diff --git a/src/server/Controller/Payment.hs b/src/server/Controller/Payment.hs
index 117310a..dc1083e 100644
--- a/src/server/Controller/Payment.hs
+++ b/src/server/Controller/Payment.hs
@@ -3,6 +3,7 @@ module Controller.Payment
, createPaymentAction
, deletePaymentAction
, getTotalPaymentsAction
+ , getPaymentsCountAction
) where
import Web.Scotty
@@ -20,6 +21,7 @@ import qualified Secure
import Model.Database
import Model.Payment
import Model.Json.Message
+import Model.Json.Number
import Model.Message
import Model.Message.Key (Key(PaymentNotDeleted))
@@ -54,3 +56,9 @@ getTotalPaymentsAction =
Secure.loggedAction (\_ -> do
(liftIO . runDb $ getTotalPayments) >>= json
)
+
+getPaymentsCountAction :: ActionM ()
+getPaymentsCountAction =
+ Secure.loggedAction (\_ -> do
+ Number <$> (liftIO . runDb $ getPaymentsCount) >>= json
+ )
diff --git a/src/server/Main.hs b/src/server/Main.hs
index 61613e6..ce652d0 100644
--- a/src/server/Main.hs
+++ b/src/server/Main.hs
@@ -57,6 +57,9 @@ main = do
get "/payments/total" $ do
getTotalPaymentsAction
+ get "/payments/count" $ do
+ getPaymentsCountAction
+
post "/signOut" $
signOutAction
diff --git a/src/server/Model/Json/Number.hs b/src/server/Model/Json/Number.hs
new file mode 100644
index 0000000..52c9da8
--- /dev/null
+++ b/src/server/Model/Json/Number.hs
@@ -0,0 +1,15 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+module Model.Json.Number
+ ( Number(..)
+ ) where
+
+import Data.Aeson
+import GHC.Generics
+
+data Number = Number
+ { number :: Int
+ } deriving (Show, Generic)
+
+instance FromJSON Number
+instance ToJSON Number
diff --git a/src/server/Model/Message/Translations.hs b/src/server/Model/Message/Translations.hs
index 9b9aafd..6c569fd 100644
--- a/src/server/Model/Message/Translations.hs
+++ b/src/server/Model/Message/Translations.hs
@@ -72,7 +72,7 @@ m l SignInMailTitle =
m l HiMail =
case l of
English -> "Hi {1},"
- French -> "Bonjour {1},"
+ French -> "Salut {1},"
m l SignInLinkMail =
case l of
diff --git a/src/server/Model/Payment.hs b/src/server/Model/Payment.hs
index 300f6b8..db1f36f 100644
--- a/src/server/Model/Payment.hs
+++ b/src/server/Model/Payment.hs
@@ -4,6 +4,7 @@ module Model.Payment
, paymentKeyToText
, deleteOwnPayment
, getTotalPayments
+ , getPaymentsCount
) where
import Data.Text (Text)
@@ -82,3 +83,11 @@ getTotalPayment (_, Nothing) = Nothing
unValueTuple :: (Value a, Value b) -> (a, b)
unValueTuple (Value a, Value b) = (a, b)
+
+getPaymentsCount :: Persist Int
+getPaymentsCount =
+ unValue . head <$>
+ (select $
+ from $ \payment -> do
+ where_ (isNothing (payment ^. PaymentDeletedAt))
+ return countRows) :: Persist Int