aboutsummaryrefslogtreecommitdiff
path: root/server/src/Persistence
diff options
context:
space:
mode:
Diffstat (limited to 'server/src/Persistence')
-rw-r--r--server/src/Persistence/Category.hs123
-rw-r--r--server/src/Persistence/Frequency.hs23
-rw-r--r--server/src/Persistence/Income.hs201
-rw-r--r--server/src/Persistence/Payment.hs389
-rw-r--r--server/src/Persistence/User.hs78
-rw-r--r--server/src/Persistence/Util.hs11
6 files changed, 825 insertions, 0 deletions
diff --git a/server/src/Persistence/Category.hs b/server/src/Persistence/Category.hs
new file mode 100644
index 0000000..b0a6fca
--- /dev/null
+++ b/server/src/Persistence/Category.hs
@@ -0,0 +1,123 @@
+module Persistence.Category
+ ( count
+ , list
+ , listAll
+ , create
+ , edit
+ , delete
+ ) where
+
+import qualified Data.Maybe as Maybe
+import Data.Text (Text)
+import Data.Time.Clock (getCurrentTime)
+import Database.SQLite.Simple (FromRow (fromRow), NamedParam ((:=)))
+import qualified Database.SQLite.Simple as SQLite
+import Prelude hiding (id)
+
+import Common.Model (Category (..), CategoryId)
+
+import Model.Query (Query (Query))
+
+newtype Row = Row Category
+
+instance FromRow Row where
+ fromRow = Row <$> (Category <$>
+ SQLite.field <*>
+ SQLite.field <*>
+ SQLite.field <*>
+ SQLite.field <*>
+ SQLite.field <*>
+ SQLite.field)
+
+data CountRow = CountRow Int
+
+instance FromRow CountRow where
+ fromRow = CountRow <$> SQLite.field
+
+count :: Query Int
+count =
+ Query (\conn ->
+ (Maybe.fromMaybe 0 . fmap (\(CountRow n) -> n) . Maybe.listToMaybe) <$>
+ SQLite.query_ conn "SELECT COUNT(*) FROM category WHERE deleted_at IS NULL"
+ )
+
+
+list :: Int -> Int -> Query [Category]
+list page perPage =
+ Query (\conn ->
+ map (\(Row c) -> c) <$>
+ SQLite.queryNamed
+ conn
+ "SELECT * FROM category WHERE deleted_at IS NULL ORDER BY name LIMIT :limit OFFSET :offset"
+ [ ":limit" := perPage
+ , ":offset" := (page - 1) * perPage
+ ]
+ )
+
+listAll :: Query [Category]
+listAll =
+ Query (\conn ->
+ map (\(Row c) -> c) <$>
+ SQLite.query_ conn "SELECT * FROM category WHERE deleted_at IS NULL"
+ )
+
+create :: Text -> Text -> Query ()
+create name color =
+ Query (\conn -> do
+ currentTime <- getCurrentTime
+ SQLite.executeNamed
+ conn
+ "INSERT INTO category (name, color, created_at) VALUES (:name, :color, :created_at)"
+ [ ":name" := name
+ , ":color" := color
+ , ":created_at" := currentTime
+ ]
+ )
+
+edit :: CategoryId -> Text -> Text -> Query Bool
+edit id name color =
+ Query (\conn -> do
+ mbCategory <- fmap (\(Row c) -> c) . Maybe.listToMaybe <$>
+ (SQLite.queryNamed conn "SELECT * FROM category WHERE id = :id" [ ":id" := id ])
+ if Maybe.isJust mbCategory
+ then do
+ currentTime <- getCurrentTime
+ SQLite.executeNamed
+ conn
+ "UPDATE category SET edited_at = :editedAt, name = :name, color = :color WHERE id = :id"
+ [ ":editedAt" := currentTime
+ , ":name" := name
+ , ":color" := color
+ , ":id" := id
+ ]
+ return True
+ else
+ return False
+ )
+
+data BoolRow = BoolRow Int
+
+instance FromRow BoolRow where
+ fromRow = BoolRow <$> SQLite.field
+
+delete :: CategoryId -> Query Bool
+delete id =
+ Query (\conn -> do
+ mbPayment <- (fmap (\(BoolRow b) -> b) . Maybe.listToMaybe) <$>
+ (SQLite.queryNamed
+ conn
+ "SELECT true FROM payment WHERE category = :id AND deleted_at IS NULL"
+ [ ":id" := id ])
+ if Maybe.isNothing mbPayment
+ then do
+ currentTime <- getCurrentTime
+ SQLite.executeNamed
+ conn
+ "UPDATE category SET deleted_at = :deletedAt WHERE id = :id AND deleted_at IS NULL"
+ [ ":deletedAt" := currentTime
+ , ":id" := id
+ ]
+ return True
+ else
+ return False
+ )
diff --git a/server/src/Persistence/Frequency.hs b/server/src/Persistence/Frequency.hs
new file mode 100644
index 0000000..edaa844
--- /dev/null
+++ b/server/src/Persistence/Frequency.hs
@@ -0,0 +1,23 @@
+module Persistence.Frequency
+ ( FrequencyField(..)
+ ) where
+
+import qualified Data.Text as T
+import Database.SQLite.Simple (SQLData (SQLText))
+import Database.SQLite.Simple.FromField (FromField (fromField),
+ fieldData)
+import Database.SQLite.Simple.Ok (Ok (Errors, Ok))
+import Database.SQLite.Simple.ToField (ToField (toField))
+
+import Common.Model (Frequency)
+
+newtype FrequencyField = FrequencyField Frequency
+
+instance FromField FrequencyField where
+ fromField field =
+ case fieldData field of
+ SQLText text -> Ok (FrequencyField (read (T.unpack text) :: Frequency))
+ _ -> Errors [error "SQLText field required for frequency"]
+
+instance ToField FrequencyField where
+ toField (FrequencyField f) = SQLText . T.pack . show $ f
diff --git a/server/src/Persistence/Income.hs b/server/src/Persistence/Income.hs
new file mode 100644
index 0000000..1b5364c
--- /dev/null
+++ b/server/src/Persistence/Income.hs
@@ -0,0 +1,201 @@
+module Persistence.Income
+ ( listAll
+ , count
+ , list
+ , listModifiedSince
+ , create
+ , edit
+ , delete
+ , definedForAll
+ , getCumulativeIncome
+ ) where
+
+import qualified Data.List as L
+import Data.Map (Map)
+import qualified Data.Map as M
+import qualified Data.Maybe as Maybe
+import qualified Data.Text as T
+import Data.Time.Calendar (Day)
+import Data.Time.Clock (UTCTime)
+import Data.Time.Clock (getCurrentTime)
+import Database.SQLite.Simple (FromRow (fromRow), NamedParam ((:=)))
+import qualified Database.SQLite.Simple as SQLite
+import Prelude hiding (id, until)
+
+import Common.Model (Income (..), IncomeId, PaymentId,
+ UserId)
+
+import Model.Query (Query (Query))
+
+newtype Row = Row Income
+
+instance FromRow Row where
+ fromRow = Row <$> (Income <$>
+ SQLite.field <*>
+ SQLite.field <*>
+ SQLite.field <*>
+ SQLite.field <*>
+ SQLite.field <*>
+ SQLite.field <*>
+ SQLite.field)
+
+data CountRow = CountRow Int
+
+instance FromRow CountRow where
+ fromRow = CountRow <$> SQLite.field
+
+listAll :: Query [Income]
+listAll =
+ Query (\conn ->
+ map (\(Row i) -> i) <$>
+ SQLite.query_
+ conn
+ "SELECT * FROM income WHERE deleted_at IS NULL ORDER BY date DESC"
+ )
+
+
+count :: Query Int
+count =
+ Query (\conn ->
+ (Maybe.fromMaybe 0 . fmap (\(CountRow n) -> n) . Maybe.listToMaybe) <$>
+ SQLite.query_ conn "SELECT COUNT(*) FROM income WHERE deleted_at IS NULL"
+ )
+
+list :: Int -> Int -> Query [Income]
+list page perPage =
+ Query (\conn ->
+ map (\(Row i) -> i) <$>
+ SQLite.queryNamed
+ conn
+ "SELECT * FROM income WHERE deleted_at IS NULL ORDER BY date DESC LIMIT :limit OFFSET :offset"
+ [ ":limit" := perPage
+ , ":offset" := (page - 1) * perPage
+ ]
+ )
+
+listModifiedSince :: UTCTime -> Query [Income]
+listModifiedSince since =
+ Query (\conn ->
+ map (\(Row i) -> i) <$>
+ SQLite.queryNamed
+ conn
+ (SQLite.Query . T.intercalate " " $
+ [ "SELECT *"
+ , "FROM income"
+ , "WHERE"
+ , "created_at >= :since"
+ , "OR edited_at >= :since"
+ , "OR deleted_at >= :since"
+ ])
+ [ ":since" := since ]
+ )
+
+create :: UserId -> Day -> Int -> Query ()
+create userId date amount =
+ Query (\conn -> do
+ createdAt <- getCurrentTime
+ SQLite.executeNamed
+ conn
+ "INSERT INTO income (user_id, date, amount, created_at) VALUES (:userId, :date, :amount, :createdAt)"
+ [ ":userId" := userId
+ , ":date" := date
+ , ":amount" := amount
+ , ":createdAt" := createdAt
+ ]
+ )
+
+edit :: UserId -> IncomeId -> Day -> Int -> Query Bool
+edit userId id date amount =
+ Query (\conn -> do
+ income <- fmap (\(Row i) -> i) . Maybe.listToMaybe <$>
+ SQLite.queryNamed conn "SELECT * FROM income WHERE id = :id" [ ":id" := id ]
+ if Maybe.isJust income then
+ do
+ currentTime <- getCurrentTime
+ SQLite.executeNamed
+ conn
+ "UPDATE income SET edited_at = :editedAt, date = :date, amount = :amount WHERE id = :id AND user_id = :userId"
+ [ ":editedAt" := currentTime
+ , ":date" := date
+ , ":amount" := amount
+ , ":id" := id
+ , ":userId" := userId
+ ]
+ return True
+ else
+ return False
+ )
+
+delete :: UserId -> PaymentId -> Query ()
+delete userId id =
+ Query (\conn ->
+ SQLite.executeNamed
+ conn
+ "UPDATE income SET deleted_at = datetime('now') WHERE id = :id AND user_id = :userId"
+ [ ":id" := id
+ , ":userId" := userId
+ ]
+ )
+
+data UserDayRow = UserDayRow (UserId, Day)
+
+instance FromRow UserDayRow where
+ fromRow = do
+ user <- SQLite.field
+ day <- SQLite.field
+ return $ UserDayRow (user, day)
+
+definedForAll :: [UserId] -> Query (Maybe Day)
+definedForAll users =
+ Query (\conn ->
+ (fromRows . fmap (\(UserDayRow (user, day)) -> (user, day))) <$>
+ SQLite.query_
+ conn
+ "SELECT user_id, MIN(date) FROM income WHERE deleted_at IS NULL GROUP BY user_id;"
+ )
+ where
+ fromRows rows =
+ if L.sort users == L.sort (map fst rows) then
+ Maybe.listToMaybe . reverse . L.sort . map snd $ rows
+ else
+ Nothing
+
+getCumulativeIncome :: Day -> Day -> Query (Map UserId Int)
+getCumulativeIncome start end =
+ Query (\conn -> M.fromList <$> SQLite.queryNamed conn (SQLite.Query query) parameters)
+ where
+ query =
+ T.intercalate "\n" $
+ [ "SELECT user_id, CAST(ROUND(SUM(count)) AS INTEGER) FROM ("
+ , " SELECT"
+ , " I1.user_id,"
+ , " ((JULIANDAY(MIN(I2.date)) - JULIANDAY(I1.date)) * I1.amount * 12 / 365) AS count"
+ , " FROM (" <> (selectBoundedIncomes ">" ":start") <> ") AS I1"
+ , " INNER JOIN (" <> (selectBoundedIncomes "<" ":end") <> ") AS I2"
+ , " ON I2.date > I1.date AND I2.user_id == I1.user_id"
+ , " GROUP BY I1.date, I1.user_id"
+ , ") GROUP BY user_id"
+ ]
+
+ selectBoundedIncomes op param =
+ T.intercalate "\n" $
+ [ " SELECT user_id, date, amount FROM ("
+ , " SELECT"
+ , " i.user_id, " <> param <> " AS date, i.amount"
+ , " FROM"
+ , " (SELECT id, MAX(date) AS max_date"
+ , " FROM income"
+ , " WHERE date <= " <> param <> " AND deleted_at IS NULL"
+ , " GROUP BY user_id) AS m"
+ , " INNER JOIN income AS i"
+ , " ON i.id = m.id AND i.date = m.max_date"
+ , " ) UNION"
+ , " SELECT user_id, date, amount"
+ , " FROM income"
+ , " WHERE date " <> op <> " " <> param <> " AND deleted_at IS NULL"
+ ]
+
+ parameters =
+ [ ":start" := start
+ , ":end" := end
+ ]
diff --git a/server/src/Persistence/Payment.hs b/server/src/Persistence/Payment.hs
new file mode 100644
index 0000000..573d57f
--- /dev/null
+++ b/server/src/Persistence/Payment.hs
@@ -0,0 +1,389 @@
+module Persistence.Payment
+ ( count
+ , find
+ , getRange
+ , listAllPunctual
+ , listActivePage
+ , listModifiedPunctualSince
+ , listActiveMonthlyOrderedByName
+ , create
+ , createMany
+ , edit
+ , delete
+ , searchCategory
+ , repartition
+ , getPreAndPostPaymentRepartition
+ , usedCategories
+ ) where
+
+import Data.Map (Map)
+import qualified Data.Map as M
+import qualified Data.Maybe as Maybe
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Time.Calendar (Day)
+import qualified Data.Time.Calendar as Calendar
+import Data.Time.Clock (UTCTime)
+import Data.Time.Clock (getCurrentTime)
+import Database.SQLite.Simple (FromRow (fromRow),
+ NamedParam ((:=)), ToRow)
+import qualified Database.SQLite.Simple as SQLite
+import Database.SQLite.Simple.ToField (ToField (toField))
+import Prelude hiding (id, until)
+
+import Common.Model (CategoryId, Frequency (..),
+ Payment (..), PaymentId,
+ User (..), UserId)
+import qualified Common.Util.Text as TextUtil
+
+import Model.Query (Query (Query))
+import Persistence.Frequency (FrequencyField (..))
+import qualified Persistence.Income as IncomePersistence
+import qualified Persistence.Util as PersistenceUtil
+
+
+fields :: Text
+fields = T.intercalate "," $
+ [ "id"
+ , "user_id"
+ , "name"
+ , "cost"
+ , "date"
+ , "category"
+ , "frequency"
+ , "created_at"
+ , "edited_at"
+ , "deleted_at"
+ ]
+
+newtype Row = Row Payment
+
+instance FromRow Row where
+ fromRow = Row <$> (Payment <$>
+ SQLite.field <*>
+ SQLite.field <*>
+ SQLite.field <*>
+ SQLite.field <*>
+ SQLite.field <*>
+ SQLite.field <*>
+ (fmap (\(FrequencyField f) -> f) $ SQLite.field) <*>
+ SQLite.field <*>
+ SQLite.field <*>
+ SQLite.field)
+
+newtype InsertRow = InsertRow Payment
+
+instance ToRow InsertRow where
+ toRow (InsertRow p) =
+ [ toField (_payment_user p)
+ , toField (_payment_name p)
+ , toField (_payment_cost p)
+ , toField (_payment_date p)
+ , toField (_payment_category p)
+ , toField (FrequencyField (_payment_frequency p))
+ , toField (_payment_createdAt p)
+ ]
+
+data Count = Count Int
+
+instance FromRow Count where
+ fromRow = Count <$> SQLite.field
+
+count :: Frequency -> Text -> Query Int
+count frequency search =
+ Query (\conn ->
+ (\[Count n] -> n) <$>
+ SQLite.queryNamed
+ conn
+ (SQLite.Query $ T.intercalate " "
+ [ "SELECT COUNT(*)"
+ , "FROM payment"
+ , "WHERE"
+ , "deleted_at IS NULL"
+ , "AND frequency = :frequency"
+ , "AND (" <> PersistenceUtil.formatKeyForSearch "name" <> " LIKE :search OR cost LIKE :search)"
+ ])
+ [ ":frequency" := FrequencyField frequency
+ , ":search" := "%" <> TextUtil.formatSearch search <> "%"
+ ]
+ )
+
+find :: PaymentId -> Query (Maybe Payment)
+find paymentId =
+ Query (\conn -> do
+ fmap (\(Row p) -> p) . Maybe.listToMaybe <$>
+ SQLite.queryNamed
+ conn
+ (SQLite.Query $ "SELECT " <> fields <> " FROM payment WHERE id = :id")
+ [ "id" := paymentId
+ ]
+ )
+
+data RangeRow = RangeRow (Day, Day)
+
+instance FromRow RangeRow where
+ fromRow = (\f t -> RangeRow (f, t)) <$> SQLite.field <*> SQLite.field
+
+getRange :: Query (Maybe (Day, Day))
+getRange =
+ Query (\conn -> do
+ fmap (\(RangeRow (f, t)) -> (f, t)) . Maybe.listToMaybe <$>
+ SQLite.queryNamed
+ conn
+ (SQLite.Query $ T.intercalate " "
+ [ "SELECT MIN(date), MAX(date)"
+ , "FROM payment"
+ , "WHERE"
+ , "frequency = :frequency"
+ , "AND deleted_at IS NULL"
+ ])
+ [ ":frequency" := FrequencyField Punctual
+ ]
+ )
+
+listAllPunctual :: Query [Payment]
+listAllPunctual =
+ Query (\conn ->
+ map (\(Row p) -> p) <$>
+ SQLite.queryNamed
+ conn
+ (SQLite.Query $ T.intercalate " "
+ [ "SELECT"
+ , fields
+ , "FROM payment"
+ , "WHERE deleted_at IS NULL AND frequency = :frequency"
+ , "ORDER BY date"
+ ])
+ [ ":frequency" := FrequencyField Punctual
+ ]
+ )
+
+
+listActivePage :: Frequency -> Int -> Int -> Text -> Query [Payment]
+listActivePage frequency page perPage search =
+ Query (\conn ->
+ map (\(Row p) -> p) <$>
+ SQLite.queryNamed
+ conn
+ (SQLite.Query $ T.intercalate " "
+ [ "SELECT"
+ , fields
+ , "FROM payment"
+ , "WHERE"
+ , "deleted_at IS NULL"
+ , "AND frequency = :frequency"
+ , "AND (" <> PersistenceUtil.formatKeyForSearch "name" <> " LIKE :search OR cost LIKE :search)"
+ , "ORDER BY date DESC"
+ , "LIMIT :limit"
+ , "OFFSET :offset"
+ ]
+ )
+ [ ":frequency" := FrequencyField frequency
+ , ":search" := "%" <> TextUtil.formatSearch search <> "%"
+ , ":limit" := perPage
+ , ":offset" := (page - 1) * perPage
+ ]
+ )
+
+listModifiedPunctualSince :: UTCTime -> Query [Payment]
+listModifiedPunctualSince since =
+ Query (\conn ->
+ map (\(Row i) -> i) <$>
+ SQLite.queryNamed
+ conn
+ (SQLite.Query . T.intercalate " " $
+ [ "SELECT " <> fields
+ , "FROM payment"
+ , "WHERE"
+ , "frequency = :frequency"
+ , "AND (created_at >= :since OR edited_at >= :since OR deleted_at >= :since)"
+ ])
+ [ ":frequency" := FrequencyField Punctual
+ , ":since" := since
+ ]
+ )
+
+
+listActiveMonthlyOrderedByName :: Query [Payment]
+listActiveMonthlyOrderedByName =
+ Query (\conn -> do
+ map (\(Row p) -> p) <$>
+ SQLite.queryNamed
+ conn
+ (SQLite.Query $ T.intercalate " "
+ [ "SELECT"
+ , fields
+ , "FROM payment"
+ , "WHERE deleted_at IS NULL AND frequency = :frequency"
+ , "ORDER BY name DESC"
+ ])
+ [ ":frequency" := FrequencyField Monthly
+ ]
+ )
+
+create :: UserId -> Text -> Int -> Day -> CategoryId -> Frequency -> Query ()
+create userId name cost date category frequency =
+ Query (\conn -> do
+ currentTime <- getCurrentTime
+ SQLite.executeNamed
+ conn
+ (SQLite.Query $ T.intercalate " "
+ [ "INSERT INTO payment (user_id, name, cost, date, category, frequency, created_at)"
+ , "VALUES (:userId, :name, :cost, :date, :category, :frequency, :currentTime)"
+ ])
+ [ ":userId" := userId
+ , ":name" := name
+ , ":cost" := cost
+ , ":date" := date
+ , ":category" := category
+ , ":frequency" := FrequencyField frequency
+ , ":currentTime" := currentTime
+ ]
+ )
+
+createMany :: [Payment] -> Query ()
+createMany payments =
+ Query (\conn ->
+ SQLite.executeMany
+ conn
+ (SQLite.Query $ T.intercalate ""
+ [ "INSERT INTO payment (user_id, name, cost, date, category, frequency, created_at)"
+ , "VALUES (?, ?, ?, ?, ?, ?, ?)"
+ ])
+ (map InsertRow payments)
+ )
+
+edit :: UserId -> PaymentId -> Text -> Int -> Day -> CategoryId -> Frequency -> Query Bool
+edit userId paymentId name cost date category frequency =
+ Query (\conn -> do
+ payment <- fmap (\(Row p) -> p) . Maybe.listToMaybe <$>
+ SQLite.queryNamed
+ conn
+ (SQLite.Query $
+ "SELECT " <> fields <> " FROM payment WHERE id = :paymentId and user_id = :userId")
+ [ ":paymentId" := paymentId
+ , ":userId" := userId
+ ]
+ if Maybe.isJust payment then
+ do
+ currentTime <- getCurrentTime
+ SQLite.executeNamed
+ conn
+ (SQLite.Query $ T.intercalate " "
+ [ "UPDATE"
+ , " payment"
+ , "SET"
+ , " edited_at = :editedAt,"
+ , " name = :name,"
+ , " cost = :cost,"
+ , " date = :date,"
+ , " category = :category,"
+ , " frequency = :frequency"
+ , "WHERE"
+ , " id = :id"
+ , " AND user_id = :userId"
+ ])
+ [ ":editedAt" := currentTime
+ , ":name" := name
+ , ":cost" := cost
+ , ":date" := date
+ , ":category" := category
+ , ":frequency" := FrequencyField frequency
+ , ":id" := paymentId
+ , ":userId" := userId
+ ]
+ return True
+ else
+ return False
+ )
+
+delete :: UserId -> PaymentId -> Query ()
+delete userId paymentId =
+ Query (\conn ->
+ SQLite.executeNamed
+ conn
+ "UPDATE payment SET deleted_at = datetime('now') WHERE id = :id AND user_id = :userId"
+ [ ":id" := paymentId
+ , ":userId" := userId
+ ]
+ )
+
+data CategoryIdRow = CategoryIdRow CategoryId
+
+instance FromRow CategoryIdRow where
+ fromRow = CategoryIdRow <$> SQLite.field
+
+searchCategory :: Text -> Query (Maybe CategoryId)
+searchCategory paymentName =
+ Query (\conn ->
+ fmap (\(CategoryIdRow d) -> d) . Maybe.listToMaybe <$>
+ SQLite.queryNamed
+ conn
+ (SQLite.Query . T.intercalate " " $
+ [ "SELECT category"
+ , "FROM payment"
+ , "WHERE deleted_at is NULL AND name LIKE :name"
+ , "ORDER BY edited_at, created_at"
+ , "LIMIT 1"
+ ])
+ [ ":name" := "%" <> paymentName <> "%"
+ ]
+ )
+
+usedCategories :: Query [CategoryId]
+usedCategories =
+ Query (\conn -> do
+ map (\(CategoryIdRow p) -> p) <$>
+ SQLite.query_
+ conn
+ (SQLite.Query $ T.intercalate " "
+ [ "SELECT DISTINCT category"
+ , "FROM payment"
+ , "WHERE deleted_at IS NULL"
+ ])
+ )
+
+data UserCostRow = UserCostRow (UserId, Int)
+
+instance FromRow UserCostRow where
+ fromRow = do
+ user <- SQLite.field
+ cost <- SQLite.field
+ return $ UserCostRow (user, cost)
+
+repartition :: Frequency -> Text -> Day -> Day -> Query (Map UserId Int)
+repartition frequency search from to =
+ Query (\conn ->
+ M.fromList . fmap (\(UserCostRow r) -> r) <$> SQLite.queryNamed
+ conn
+ (SQLite.Query . T.intercalate " " $
+ [ "SELECT user_id, SUM(cost)"
+ , "FROM payment"
+ , "WHERE"
+ , "deleted_at IS NULL"
+ , "AND frequency = :frequency"
+ , "AND (" <> PersistenceUtil.formatKeyForSearch "name" <> " LIKE :search OR cost LIKE :search)"
+ , "AND date >= :from"
+ , "AND date < :to"
+ , "GROUP BY user_id"
+ ])
+ [ ":frequency" := FrequencyField frequency
+ , ":search" := "%" <> TextUtil.formatSearch search <> "%"
+ , ":from" := from
+ , ":to" := to
+ ]
+ )
+
+getPreAndPostPaymentRepartition :: Maybe (Day, Day) -> [User] -> Query (Map UserId Int, Map UserId Int)
+getPreAndPostPaymentRepartition paymentRange users = do
+ case paymentRange of
+ Just (from, to) -> do
+ incomeDefinedForAll <- IncomePersistence.definedForAll (_user_id <$> users)
+ (,)
+ <$> (repartition Punctual "" from (Maybe.fromMaybe (Calendar.addDays 1 to) incomeDefinedForAll))
+ <*> (case incomeDefinedForAll of
+ Just d -> repartition Punctual "" d (Calendar.addDays 1 to)
+ Nothing -> return M.empty)
+
+ Nothing ->
+ return (M.empty, M.empty)
diff --git a/server/src/Persistence/User.hs b/server/src/Persistence/User.hs
new file mode 100644
index 0000000..12145ac
--- /dev/null
+++ b/server/src/Persistence/User.hs
@@ -0,0 +1,78 @@
+module Persistence.User
+ ( list
+ , get
+ , checkPassword
+ , createSignInToken
+ ) where
+
+import qualified Data.Maybe as Maybe
+import Data.Text (Text)
+import Database.SQLite.Simple (FromRow (fromRow), NamedParam ((:=)))
+import qualified Database.SQLite.Simple as SQLite
+
+import Common.Model (Email (..), Password (..), User (..))
+
+import Model.HashedPassword (HashedPassword (..))
+import qualified Model.HashedPassword as HashedPassword
+import Model.Query (Query (Query))
+import qualified Model.UUID as UUID
+
+newtype Row = Row User
+
+instance FromRow Row where
+ fromRow = Row <$> (User <$>
+ SQLite.field <*>
+ SQLite.field <*>
+ SQLite.field <*>
+ SQLite.field)
+
+list :: Query [User]
+list =
+ Query (\conn -> do
+ map (\(Row u) -> u) <$>
+ SQLite.query_ conn "SELECT id, creation, email, name from user ORDER BY creation DESC"
+ )
+
+get :: Text -> Query (Maybe User)
+get token =
+ Query (\conn -> do
+ fmap (\(Row u) -> u) . Maybe.listToMaybe <$>
+ SQLite.queryNamed
+ conn
+ "SELECT id, creation, email, name FROM user WHERE sign_in_token = :sign_in_token LIMIT 1"
+ [ ":sign_in_token" := token ]
+ )
+
+data HashedPasswordRow = HashedPasswordRow HashedPassword
+
+instance FromRow HashedPasswordRow where
+ fromRow = HashedPasswordRow <$> (HashedPassword <$> SQLite.field)
+
+checkPassword :: Email -> Password -> Query Bool
+checkPassword (Email email) password =
+ Query (\conn -> do
+ hashedPassword <- fmap (\(HashedPasswordRow p) -> p) . Maybe.listToMaybe <$>
+ SQLite.queryNamed
+ conn
+ "SELECT password FROM user WHERE email = :email LIMIT 1"
+ [ ":email" := email ]
+ case hashedPassword of
+ Just h ->
+ return (HashedPassword.check password h)
+
+ Nothing ->
+ return False
+ )
+
+createSignInToken :: Email -> Query Text
+createSignInToken (Email email) =
+ Query (\conn -> do
+ token <- UUID.generateUUID
+ SQLite.executeNamed
+ conn
+ "UPDATE user SET sign_in_token = :sign_in_token WHERE email = :email"
+ [ ":sign_in_token" := token
+ , ":email" := email
+ ]
+ return token
+ )
diff --git a/server/src/Persistence/Util.hs b/server/src/Persistence/Util.hs
new file mode 100644
index 0000000..b7496c6
--- /dev/null
+++ b/server/src/Persistence/Util.hs
@@ -0,0 +1,11 @@
+module Persistence.Util
+ ( formatKeyForSearch
+ ) where
+
+import Data.Text (Text)
+
+formatKeyForSearch :: Text -> Text
+formatKeyForSearch key =
+ "replace(replace(replace(replace(replace(replace(replace(replace(replace(replace(replace(replace(replace(lower("
+ <> key
+ <> "), 'à', 'a'), 'â', 'a'), 'ç', 'c'), 'è', 'e'), 'é', 'e'), 'ê', 'e'), 'ë', 'e'), 'î', 'i'), 'ï', 'i'), 'ô', 'o'), 'ù', 'u'), 'û', 'u'), 'ü', 'u')"