aboutsummaryrefslogtreecommitdiff
path: root/src/server/Model
diff options
context:
space:
mode:
Diffstat (limited to 'src/server/Model')
-rw-r--r--src/server/Model/Database.hs12
-rw-r--r--src/server/Model/Job.hs27
-rw-r--r--src/server/Model/JobKind.hs13
-rw-r--r--src/server/Model/Payment.hs10
4 files changed, 56 insertions, 6 deletions
diff --git a/src/server/Model/Database.hs b/src/server/Model/Database.hs
index d4a7d50..0bbc353 100644
--- a/src/server/Model/Database.hs
+++ b/src/server/Model/Database.hs
@@ -22,14 +22,15 @@ import Database.Persist.Sqlite
import Database.Persist.TH
import Model.Frequency
+import Model.JobKind
share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
User
creation UTCTime
email Text
name Text
- UniqEmail email
- UniqName name
+ UniqUserEmail email
+ UniqUserName name
deriving Show
Payment
userId UserId
@@ -44,7 +45,12 @@ SignIn
creation UTCTime
email Text
isUsed Bool
- UniqToken token
+ UniqSignInToken token
+ deriving Show
+Job
+ kind JobKind
+ lastExecution UTCTime Maybe
+ UniqJobName kind
deriving Show
|]
diff --git a/src/server/Model/Job.hs b/src/server/Model/Job.hs
new file mode 100644
index 0000000..3d5df96
--- /dev/null
+++ b/src/server/Model/Job.hs
@@ -0,0 +1,27 @@
+module Model.Job
+ ( getLastExecution
+ , actualizeLastExecution
+ ) where
+
+import Control.Monad.IO.Class (liftIO)
+
+import Data.Time.Clock (UTCTime, getCurrentTime)
+import Data.Maybe (isJust)
+
+import Database.Persist
+
+import Model.Database
+import Model.JobKind
+
+getLastExecution :: JobKind -> Persist (Maybe UTCTime)
+getLastExecution kind = do
+ mbJob <- fmap entityVal <$> selectFirst [JobKind ==. kind] []
+ return (mbJob >>= jobLastExecution)
+
+actualizeLastExecution :: JobKind -> Persist ()
+actualizeLastExecution kind = do
+ now <- liftIO getCurrentTime
+ jobKindDefined <- isJust <$> selectFirst [JobKind ==. kind] []
+ if jobKindDefined
+ then updateWhere [JobKind ==. kind] [JobLastExecution =. Just now]
+ else insert (Job kind (Just now)) >> return ()
diff --git a/src/server/Model/JobKind.hs b/src/server/Model/JobKind.hs
new file mode 100644
index 0000000..bbe1d45
--- /dev/null
+++ b/src/server/Model/JobKind.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Model.JobKind
+ ( JobKind(..)
+ ) where
+
+import Database.Persist.TH
+
+data JobKind =
+ MonthlyPaymentJob
+ deriving (Eq, Show, Read)
+
+derivePersistField "JobKind"
diff --git a/src/server/Model/Payment.hs b/src/server/Model/Payment.hs
index 381578a..f07cec4 100644
--- a/src/server/Model/Payment.hs
+++ b/src/server/Model/Payment.hs
@@ -1,5 +1,6 @@
module Model.Payment
( getPunctualPayments
+ , getUserMonthlyPayments
, getMonthlyPayments
, createPayment
, deleteOwnPayment
@@ -36,14 +37,17 @@ getPunctualPayments page perPage = do
return (payment, user)
return (map getJsonPayment xs)
-getMonthlyPayments :: UserId -> Persist [P.Payment]
-getMonthlyPayments userId = do
+getUserMonthlyPayments :: UserId -> Persist [P.Payment]
+getUserMonthlyPayments userId =
+ filter ((==) userId . P.userId) <$> getMonthlyPayments
+
+getMonthlyPayments :: Persist [P.Payment]
+getMonthlyPayments = do
xs <- select $
from $ \(payment `InnerJoin` user) -> do
on (payment ^. PaymentUserId E.==. user ^. UserId)
where_ (isNothing (payment ^. PaymentDeletedAt))
where_ (payment ^. PaymentFrequency E.==. val Monthly)
- where_ (payment ^. PaymentUserId E.==. val userId)
orderBy [desc (payment ^. PaymentCreation)]
return (payment, user)
return (map getJsonPayment xs)