aboutsummaryrefslogtreecommitdiff
path: root/server/src
diff options
context:
space:
mode:
Diffstat (limited to 'server/src')
-rw-r--r--server/src/Controller/Category.hs66
-rw-r--r--server/src/Controller/Helper.hs11
-rw-r--r--server/src/Controller/Income.hs16
-rw-r--r--server/src/Controller/Payment.hs17
-rw-r--r--server/src/Json.hs16
-rw-r--r--server/src/Main.hs9
-rw-r--r--server/src/Model/CreateCategory.hs10
-rw-r--r--server/src/Model/EditCategory.hs13
-rw-r--r--server/src/Persistence/Category.hs34
-rw-r--r--server/src/Persistence/Income.hs45
-rw-r--r--server/src/Persistence/Payment.hs48
-rw-r--r--server/src/Validation/Category.hs27
12 files changed, 184 insertions, 128 deletions
diff --git a/server/src/Controller/Category.hs b/server/src/Controller/Category.hs
index 8fbc8c8..36ce3fc 100644
--- a/server/src/Controller/Category.hs
+++ b/server/src/Controller/Category.hs
@@ -1,5 +1,6 @@
module Controller.Category
- ( list
+ ( listAll
+ , list
, create
, edit
, delete
@@ -7,37 +8,68 @@ module Controller.Category
import Control.Monad.IO.Class (liftIO)
import qualified Data.Text.Lazy as TL
+import Data.Validation (Validation (..))
import Network.HTTP.Types.Status (badRequest400, ok200)
import Web.Scotty hiding (delete)
-import Common.Model (CategoryId, CreateCategory (..),
- EditCategory (..))
+import Common.Model (CategoryId, CategoryPage (..),
+ CreateCategoryForm (..),
+ EditCategoryForm (..))
import qualified Common.Msg as Msg
-import Json (jsonId)
+import qualified Controller.Helper as ControllerHelper
+import Model.CreateCategory (CreateCategory (..))
+import Model.EditCategory (EditCategory (..))
import qualified Model.Query as Query
import qualified Persistence.Category as CategoryPersistence
import qualified Secure
+import qualified Validation.Category as CategoryValidation
-list :: ActionM ()
-list =
+listAll :: ActionM ()
+listAll =
Secure.loggedAction (\_ ->
- (liftIO . Query.run $ CategoryPersistence.list) >>= json
+ (liftIO . Query.run $ CategoryPersistence.listAll) >>= json
)
-create :: CreateCategory -> ActionM ()
-create (CreateCategory name color) =
+list :: Int -> Int -> ActionM ()
+list page perPage =
Secure.loggedAction (\_ ->
- (liftIO . Query.run $ CategoryPersistence.create name color) >>= jsonId
+ (liftIO . Query.run $ do
+ categories <- CategoryPersistence.list page perPage
+ count <- CategoryPersistence.count
+ return $ CategoryPage page categories count
+ ) >>= json
)
-edit :: EditCategory -> ActionM ()
-edit (EditCategory categoryId name color) =
- Secure.loggedAction (\_ -> do
- updated <- liftIO . Query.run $ CategoryPersistence.edit categoryId name color
- if updated
- then status ok200
- else status badRequest400
+create :: CreateCategoryForm -> ActionM ()
+create form =
+ Secure.loggedAction (\_ ->
+ (liftIO . Query.run $ do
+ case CategoryValidation.createCategory form of
+ Success (CreateCategory name color) -> do
+ Right <$> (CategoryPersistence.create name color)
+
+ Failure validationError ->
+ return $ Left validationError
+ ) >>= ControllerHelper.okOrBadRequest
+ )
+
+edit :: EditCategoryForm -> ActionM ()
+edit form =
+ Secure.loggedAction (\_ ->
+ (liftIO . Query.run $ do
+ case CategoryValidation.editCategory form of
+ Success (EditCategory categoryId name color) ->
+ do
+ isSuccess <- CategoryPersistence.edit categoryId name color
+ return $ if isSuccess then
+ Right ()
+ else
+ Left $ Msg.get Msg.Error_CategoryEdit
+
+ Failure validationError ->
+ return $ Left validationError
+ ) >>= ControllerHelper.okOrBadRequest
)
delete :: CategoryId -> ActionM ()
diff --git a/server/src/Controller/Helper.hs b/server/src/Controller/Helper.hs
index fd0d2bb..dc9cbc4 100644
--- a/server/src/Controller/Helper.hs
+++ b/server/src/Controller/Helper.hs
@@ -1,17 +1,16 @@
module Controller.Helper
- ( jsonOrBadRequest
+ ( okOrBadRequest
) where
-import Data.Aeson (ToJSON)
import Data.Text (Text)
import qualified Data.Text.Lazy as LT
import qualified Network.HTTP.Types.Status as Status
import Web.Scotty (ActionM)
import qualified Web.Scotty as S
-jsonOrBadRequest :: forall a. (ToJSON a) => Either Text a -> ActionM ()
-jsonOrBadRequest (Left message) = do
+okOrBadRequest :: Either Text () -> ActionM ()
+okOrBadRequest (Left message) = do
S.status Status.badRequest400
S.text (LT.fromStrict message)
-jsonOrBadRequest (Right a) =
- S.json a
+okOrBadRequest (Right ()) =
+ S.status Status.ok200
diff --git a/server/src/Controller/Income.hs b/server/src/Controller/Income.hs
index 784a2db..96ccbbc 100644
--- a/server/src/Controller/Income.hs
+++ b/server/src/Controller/Income.hs
@@ -8,7 +8,7 @@ module Controller.Income
import Control.Monad.IO.Class (liftIO)
import qualified Data.Map as M
import qualified Data.Time.Clock as Clock
-import Data.Validation (Validation (Failure, Success))
+import Data.Validation (Validation (..))
import qualified Network.HTTP.Types.Status as Status
import Web.Scotty hiding (delete)
@@ -16,6 +16,7 @@ import Common.Model (CreateIncomeForm (..),
EditIncomeForm (..),
IncomeHeader (..), IncomeId,
IncomePage (..), User (..))
+import qualified Common.Msg as Msg
import qualified Controller.Helper as ControllerHelper
import Model.CreateIncome (CreateIncome (..))
@@ -60,7 +61,7 @@ create form =
Failure validationError ->
return $ Left validationError
- ) >>= ControllerHelper.jsonOrBadRequest
+ ) >>= ControllerHelper.okOrBadRequest
)
edit :: EditIncomeForm -> ActionM ()
@@ -68,12 +69,17 @@ edit form =
Secure.loggedAction (\user ->
(liftIO . Query.run $ do
case IncomeValidation.editIncome form of
- Success (EditIncome incomeId amount date) -> do
- Right <$> (IncomePersistence.edit (_user_id user) incomeId date amount)
+ Success (EditIncome incomeId amount date) ->
+ do
+ isSuccess <- IncomePersistence.edit (_user_id user) incomeId date amount
+ return $ if isSuccess then
+ Right ()
+ else
+ Left $ Msg.get Msg.Error_IncomeEdit
Failure validationError ->
return $ Left validationError
- ) >>= ControllerHelper.jsonOrBadRequest
+ ) >>= ControllerHelper.okOrBadRequest
)
delete :: IncomeId -> ActionM ()
diff --git a/server/src/Controller/Payment.hs b/server/src/Controller/Payment.hs
index 42a4436..d6aa34f 100644
--- a/server/src/Controller/Payment.hs
+++ b/server/src/Controller/Payment.hs
@@ -8,7 +8,6 @@ module Controller.Payment
import Control.Monad.IO.Class (liftIO)
import qualified Data.Map as M
-import qualified Data.Maybe as Maybe
import Data.Text (Text)
import qualified Data.Time.Calendar as Calendar
import Data.Validation (Validation (Failure, Success))
@@ -77,30 +76,30 @@ create :: CreatePaymentForm -> ActionM ()
create form =
Secure.loggedAction (\user ->
(liftIO . Query.run $ do
- cs <- map _category_id <$> CategoryPersistence.list
+ cs <- map _category_id <$> CategoryPersistence.listAll
case PaymentValidation.createPayment cs form of
Success (CreatePayment name cost date category frequency) ->
Right <$> PaymentPersistence.create (_user_id user) name cost date category frequency
Failure validationError ->
return $ Left validationError
- ) >>= ControllerHelper.jsonOrBadRequest
+ ) >>= ControllerHelper.okOrBadRequest
)
edit :: EditPaymentForm -> ActionM ()
edit form =
Secure.loggedAction (\user ->
(liftIO . Query.run $ do
- cs <- map _category_id <$> CategoryPersistence.list
+ cs <- map _category_id <$> CategoryPersistence.listAll
case PaymentValidation.editPayment cs form of
Success (EditPayment paymentId name cost date category frequency) -> do
- editedPayment <- PaymentPersistence.edit (_user_id user) paymentId name cost date category frequency
- if Maybe.isJust editedPayment then
- return . Right $ editedPayment
+ isSuccess <- PaymentPersistence.edit (_user_id user) paymentId name cost date category frequency
+ return $ if isSuccess then
+ Right ()
else
- return . Left $ Msg.get Msg.Error_PaymentEdit
+ Left $ Msg.get Msg.Error_PaymentEdit
Failure validationError ->
return $ Left validationError
- ) >>= ControllerHelper.jsonOrBadRequest
+ ) >>= ControllerHelper.okOrBadRequest
)
delete :: PaymentId -> ActionM ()
diff --git a/server/src/Json.hs b/server/src/Json.hs
deleted file mode 100644
index 6d40305..0000000
--- a/server/src/Json.hs
+++ /dev/null
@@ -1,16 +0,0 @@
-module Json
- ( jsonObject
- , jsonId
- ) where
-
-import qualified Data.Aeson.Types as Json
-import qualified Data.HashMap.Strict as M
-import Data.Int (Int64)
-import Data.Text (Text)
-import Web.Scotty
-
-jsonObject :: [(Text, Json.Value)] -> ActionM ()
-jsonObject = json . Json.Object . M.fromList
-
-jsonId :: Int64 -> ActionM ()
-jsonId key = json . Json.Object . M.fromList $ [("id", Json.Number . fromIntegral $ key)]
diff --git a/server/src/Main.hs b/server/src/Main.hs
index f4d75a0..0b80de0 100644
--- a/server/src/Main.hs
+++ b/server/src/Main.hs
@@ -77,8 +77,13 @@ main = do
incomeId <- S.param "id"
Income.delete incomeId
- S.get "/api/categories" $
- Category.list
+ S.get "/api/allCategories" $ do
+ Category.listAll
+
+ S.get "/api/categories" $ do
+ page <- S.param "page"
+ perPage <- S.param "perPage"
+ Category.list page perPage
S.post "/api/category" $
S.jsonData >>= Category.create
diff --git a/server/src/Model/CreateCategory.hs b/server/src/Model/CreateCategory.hs
new file mode 100644
index 0000000..dae061b
--- /dev/null
+++ b/server/src/Model/CreateCategory.hs
@@ -0,0 +1,10 @@
+module Model.CreateCategory
+ ( CreateCategory(..)
+ ) where
+
+import Data.Text (Text)
+
+data CreateCategory = CreateCategory
+ { _createCategory_name :: Text
+ , _createCategory_color :: Text
+ } deriving (Show)
diff --git a/server/src/Model/EditCategory.hs b/server/src/Model/EditCategory.hs
new file mode 100644
index 0000000..8ee26ac
--- /dev/null
+++ b/server/src/Model/EditCategory.hs
@@ -0,0 +1,13 @@
+module Model.EditCategory
+ ( EditCategory(..)
+ ) where
+
+import Data.Text (Text)
+
+import Common.Model (CategoryId)
+
+data EditCategory = EditCategory
+ { _editCategory_id :: CategoryId
+ , _editCategory_name :: Text
+ , _editCategory_color :: Text
+ } deriving (Show)
diff --git a/server/src/Persistence/Category.hs b/server/src/Persistence/Category.hs
index 00cf0a5..2934b28 100644
--- a/server/src/Persistence/Category.hs
+++ b/server/src/Persistence/Category.hs
@@ -1,5 +1,7 @@
module Persistence.Category
- ( list
+ ( count
+ , list
+ , listAll
, create
, edit
, delete
@@ -27,14 +29,37 @@ instance FromRow Row where
SQLite.field <*>
SQLite.field)
-list :: Query [Category]
-list =
+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.query
+ conn
+ "SELECT * FROM category WHERE deleted_at IS NULL ORDER BY edited_at, created_at DESC LIMIT ? OFFSET ?"
+ (perPage, (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 CategoryId
+create :: Text -> Text -> Query ()
create categoryName categoryColor =
Query (\conn -> do
now <- getCurrentTime
@@ -42,7 +67,6 @@ create categoryName categoryColor =
conn
"INSERT INTO category (name, color, created_at) VALUES (?, ?, ?)"
(categoryName, categoryColor, now)
- SQLite.lastInsertRowId conn
)
edit :: CategoryId -> Text -> Text -> Query Bool
diff --git a/server/src/Persistence/Income.hs b/server/src/Persistence/Income.hs
index e689505..cd98814 100644
--- a/server/src/Persistence/Income.hs
+++ b/server/src/Persistence/Income.hs
@@ -78,7 +78,7 @@ listModifiedSince since =
(since, since, since)
)
-create :: UserId -> Day -> Int -> Query Income
+create :: UserId -> Day -> Int -> Query ()
create userId date amount =
Query (\conn -> do
createdAt <- getCurrentTime
@@ -86,42 +86,23 @@ create userId date amount =
conn
"INSERT INTO income (user_id, date, amount, created_at) VALUES (?, ?, ?, ?)"
(userId, date, amount, createdAt)
- incomeId <- SQLite.lastInsertRowId conn
- return $ Income
- { _income_id = incomeId
- , _income_userId = userId
- , _income_date = date
- , _income_amount = amount
- , _income_createdAt = createdAt
- , _income_editedAt = Nothing
- , _income_deletedAt = Nothing
- }
)
-edit :: UserId -> IncomeId -> Day -> Int -> Query (Maybe Income)
+edit :: UserId -> IncomeId -> Day -> Int -> Query Bool
edit userId incomeId incomeDate incomeAmount =
Query (\conn -> do
- mbIncome <- fmap (\(Row i) -> i) . Maybe.listToMaybe <$>
+ income <- fmap (\(Row i) -> i) . Maybe.listToMaybe <$>
SQLite.query conn "SELECT * FROM income WHERE id = ?" (Only incomeId)
- case mbIncome of
- Just income ->
- do
- currentTime <- getCurrentTime
- SQLite.execute
- conn
- "UPDATE income SET edited_at = ?, date = ?, amount = ? WHERE id = ? AND user_id = ?"
- (currentTime, incomeDate, incomeAmount, incomeId, userId)
- return . Just $ Income
- { _income_id = incomeId
- , _income_userId = userId
- , _income_date = incomeDate
- , _income_amount = incomeAmount
- , _income_createdAt = _income_createdAt income
- , _income_editedAt = Just currentTime
- , _income_deletedAt = Nothing
- }
- Nothing ->
- return Nothing
+ if Maybe.isJust income then
+ do
+ currentTime <- getCurrentTime
+ SQLite.execute
+ conn
+ "UPDATE income SET edited_at = ?, date = ?, amount = ? WHERE id = ? AND user_id = ?"
+ (currentTime, incomeDate, incomeAmount, incomeId, userId)
+ return True
+ else
+ return False
)
delete :: UserId -> PaymentId -> Query ()
diff --git a/server/src/Persistence/Payment.hs b/server/src/Persistence/Payment.hs
index 953f0ae..da877ff 100644
--- a/server/src/Persistence/Payment.hs
+++ b/server/src/Persistence/Payment.hs
@@ -190,30 +190,17 @@ listActiveMonthlyOrderedByName =
(Only (FrequencyField Monthly))
)
-create :: UserId -> Text -> Int -> Day -> CategoryId -> Frequency -> Query Payment
+create :: UserId -> Text -> Int -> Day -> CategoryId -> Frequency -> Query ()
create userId name cost date category frequency =
Query (\conn -> do
- time <- getCurrentTime
+ currentTime <- getCurrentTime
SQLite.execute
conn
(SQLite.Query $ T.intercalate " "
[ "INSERT INTO payment (user_id, name, cost, date, category, frequency, created_at)"
, "VALUES (?, ?, ?, ?, ?, ?, ?)"
])
- (userId, name, cost, date, category, FrequencyField frequency, time)
- paymentId <- SQLite.lastInsertRowId conn
- return $ Payment
- { _payment_id = paymentId
- , _payment_user = userId
- , _payment_name = name
- , _payment_cost = cost
- , _payment_date = date
- , _payment_category = category
- , _payment_frequency = frequency
- , _payment_createdAt = time
- , _payment_editedAt = Nothing
- , _payment_deletedAt = Nothing
- }
+ (userId, name, cost, date, category, FrequencyField frequency, currentTime)
)
createMany :: [Payment] -> Query ()
@@ -228,17 +215,17 @@ createMany payments =
(map InsertRow payments)
)
-edit :: UserId -> PaymentId -> Text -> Int -> Day -> CategoryId -> Frequency -> Query (Maybe Payment)
+edit :: UserId -> PaymentId -> Text -> Int -> Day -> CategoryId -> Frequency -> Query Bool
edit userId paymentId name cost date category frequency =
Query (\conn -> do
- mbPayment <- fmap (\(Row p) -> p) . Maybe.listToMaybe <$>
+ payment <- fmap (\(Row p) -> p) . Maybe.listToMaybe <$>
SQLite.query
conn
(SQLite.Query $ "SELECT " <> fields <> " FROM payment WHERE id = ? and user_id = ?")
(paymentId, userId)
- case mbPayment of
- Just payment -> do
- now <- getCurrentTime
+ if Maybe.isJust payment then
+ do
+ currentTime <- getCurrentTime
SQLite.execute
conn
(SQLite.Query $ T.intercalate " "
@@ -255,7 +242,7 @@ edit userId paymentId name cost date category frequency =
, " id = ?"
, " AND user_id = ?"
])
- ( now
+ ( currentTime
, name
, cost
, date
@@ -264,20 +251,9 @@ edit userId paymentId name cost date category frequency =
, paymentId
, userId
)
- return . Just $ Payment
- { _payment_id = paymentId
- , _payment_user = userId
- , _payment_name = name
- , _payment_cost = cost
- , _payment_date = date
- , _payment_category = category
- , _payment_frequency = frequency
- , _payment_createdAt = _payment_createdAt payment
- , _payment_editedAt = Just now
- , _payment_deletedAt = Nothing
- }
- Nothing ->
- return Nothing
+ return True
+ else
+ return False
)
delete :: UserId -> PaymentId -> Query ()
diff --git a/server/src/Validation/Category.hs b/server/src/Validation/Category.hs
new file mode 100644
index 0000000..12f2117
--- /dev/null
+++ b/server/src/Validation/Category.hs
@@ -0,0 +1,27 @@
+module Validation.Category
+ ( createCategory
+ , editCategory
+ ) where
+
+import Data.Text (Text)
+import Data.Validation (Validation)
+import qualified Data.Validation as V
+
+import Common.Model (CreateCategoryForm (..),
+ EditCategoryForm (..))
+import qualified Common.Validation.Category as CategoryValidation
+import Model.CreateCategory (CreateCategory (..))
+import Model.EditCategory (EditCategory (..))
+
+createCategory :: CreateCategoryForm -> Validation Text CreateCategory
+createCategory form =
+ CreateCategory
+ <$> CategoryValidation.name (_createCategoryForm_name form)
+ <*> CategoryValidation.color (_createCategoryForm_color form)
+
+editCategory :: EditCategoryForm -> Validation Text EditCategory
+editCategory form =
+ EditCategory
+ <$> V.Success (_editCategoryForm_id form)
+ <*> CategoryValidation.name (_editCategoryForm_name form)
+ <*> CategoryValidation.color (_editCategoryForm_color form)
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-23 02:01:41 +0000